![[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] / 43BSDReno / contrib / emacs-18.55 / lisp|
Return to dired.el CVS log | Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / 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 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: ;In loaddefs.el ! 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: (message "Reading directory %s..." dirname) ! 34: (set-buffer buffer) ! 35: (let ((buffer-read-only nil)) ! 36: (widen) ! 37: (erase-buffer) ! 38: (setq dirname (expand-file-name dirname)) ! 39: (if (file-directory-p dirname) ! 40: (call-process "ls" nil buffer nil ! 41: dired-listing-switches dirname) ! 42: (let ((default-directory (file-name-directory dirname))) ! 43: (call-process shell-file-name nil buffer nil ! 44: "-c" (concat "ls " dired-listing-switches " " ! 45: (file-name-nondirectory dirname))))) ! 46: (goto-char (point-min)) ! 47: (while (not (eobp)) ! 48: (insert " ") ! 49: (forward-line 1)) ! 50: (goto-char (point-min))) ! 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: (from-file (dired-get-filename)) ! 483: (to-file (concat from-file ".Z"))) ! 484: (if (string-match "\\.Z$" from-file) ! 485: (error "%s is already compressed!" from-file)) ! 486: (message "Compressing %s..." from-file) ! 487: (call-process "compress" nil nil nil "-f" from-file) ! 488: (message "Compressing %s... done" from-file) ! 489: (dired-redisplay to-file))) ! 490: ! 491: (defun dired-uncompress () ! 492: "Uncompress this file." ! 493: (interactive) ! 494: (let* ((buffer-read-only nil) ! 495: (from-file (dired-get-filename)) ! 496: (to-file (substring from-file 0 -2))) ! 497: (if (string-match "\\.Z$" from-file) nil ! 498: (error "%s is not compressed!" from-file)) ! 499: (message "Uncompressing %s..." from-file) ! 500: (call-process "uncompress" nil nil nil from-file) ! 501: (message "Uncompressing %s... done" from-file) ! 502: (dired-redisplay to-file))) ! 503: ! 504: (defun dired-byte-recompile () ! 505: "Byte recompile this file." ! 506: (interactive) ! 507: (let* ((buffer-read-only nil) ! 508: (from-file (dired-get-filename)) ! 509: (to-file (substring from-file 0 -3))) ! 510: (if (string-match "\\.el$" from-file) nil ! 511: (error "%s is uncompilable!" from-file)) ! 512: (byte-compile-file from-file))) ! 513: ! 514: (defun dired-chmod (mode) ! 515: "Change mode of this file." ! 516: (interactive "sChange to Mode: ") ! 517: (let ((buffer-read-only nil) ! 518: (file (dired-get-filename))) ! 519: (call-process "/bin/chmod" nil nil nil mode file) ! 520: (dired-redisplay file))) ! 521: ! 522: (defun dired-chgrp (group) ! 523: "Change group of this file." ! 524: (interactive "sChange to Group: ") ! 525: (let ((buffer-read-only nil) ! 526: (file (dired-get-filename))) ! 527: (call-process "/bin/chgrp" nil nil nil group file) ! 528: (dired-redisplay file))) ! 529: ! 530: (defun dired-chown (owner) ! 531: "Change Owner of this file." ! 532: (interactive "sChange to Owner: ") ! 533: (let ((buffer-read-only nil) ! 534: (file (dired-get-filename))) ! 535: (call-process "/etc/chown" nil nil nil owner file) ! 536: (dired-redisplay file))) ! 537: ! 538: (defun dired-redisplay (file) "Redisplay this line." ! 539: (beginning-of-line) ! 540: (delete-region (point) (progn (forward-line 1) (point))) ! 541: (if file (dired-add-entry (file-name-directory file) ! 542: (file-name-nondirectory file))) ! 543: (dired-move-to-filename)) ! 544: ! 545: (defun dired-do-deletions () ! 546: "In dired, delete the files flagged for deletion." ! 547: (interactive) ! 548: (let (delete-list answer) ! 549: (save-excursion ! 550: (goto-char 1) ! 551: (while (re-search-forward "^D" nil t) ! 552: (setq delete-list ! 553: (cons (cons (dired-get-filename t) (1- (point))) ! 554: delete-list)))) ! 555: (if (null delete-list) ! 556: (message "(No deletions requested)") ! 557: (save-window-excursion ! 558: (switch-to-buffer " *Deletions*") ! 559: (erase-buffer) ! 560: (setq fill-column 70) ! 561: (let ((l (reverse delete-list))) ! 562: ;; Files should be in forward order for this loop. ! 563: (while l ! 564: (if (> (current-column) 59) ! 565: (insert ?\n) ! 566: (or (bobp) ! 567: (indent-to (* (/ (+ (current-column) 19) 20) 20) 1))) ! 568: (insert (car (car l))) ! 569: (setq l (cdr l)))) ! 570: (goto-char (point-min)) ! 571: (setq answer (yes-or-no-p "Delete these files? "))) ! 572: (if answer ! 573: (let ((l delete-list) ! 574: failures) ! 575: ;; Files better be in reverse order for this loop! ! 576: ;; That way as changes are made in the buffer ! 577: ;; they do not shift the lines still to be changed. ! 578: (while l ! 579: (goto-char (cdr (car l))) ! 580: (let ((buffer-read-only nil)) ! 581: (condition-case () ! 582: (let ((fn (concat default-directory (car (car l))))) ! 583: (if (file-directory-p fn) ! 584: (progn ! 585: (call-process "rmdir" nil nil nil fn) ! 586: (if (file-exists-p fn) (delete-file fn))) ! 587: (delete-file fn)) ! 588: (delete-region (point) ! 589: (progn (forward-line 1) (point)))) ! 590: (error (delete-char 1) ! 591: (insert " ") ! 592: (setq failures (cons (car (car l)) failures))))) ! 593: (setq l (cdr l))) ! 594: (if failures ! 595: (message "Deletions failed: %s" ! 596: (prin1-to-string failures)))))))) ! 597: ! 598: (provide 'dired)
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.