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