Annotation of 43BSDReno/contrib/emacs-18.55/lisp/dired.el, revision 1.1.1.1

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)

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.