-;; dired-aux.el --- all of dired except what people usually use
+;;; dired-aux.el --- all of dired except what people usually use
;; Copyright (C) 1985, 1986, 1992 Free Software Foundation, Inc.
;;; Commentary:
+;; The parts of dired mode not normally used. This is a space-saving hack
+;; to avoid having to load a large mode when all that's wanted are a few
+;; functions.
+
;; Rewritten in 1990/1991 to add tree features, file marking and
;; sorting by Sebastian Kremer <sk@thp.uni-koeln.de>.
;; Finished up by rms in 1992.
;; Compress or uncompress the current file.
;; Return nil for success, offending filename else.
(let* (buffer-read-only
- (from-file (dired-get-filename)))
- (cond ((save-excursion (beginning-of-line)
- (looking-at dired-re-sym))
- (dired-log (concat "Attempt to compress a symbolic link:\n"
- from-file))
- (dired-make-relative from-file))
- ((string-match "\\.Z$" from-file)
- (if (dired-check-process (concat "Uncompressing " from-file)
- "uncompress" from-file)
- (dired-make-relative from-file)
- (dired-update-file-line (substring from-file 0 -2))))
+ (from-file (dired-get-filename))
+ (new-file (dired-compress-file from-file)))
+ (if new-file
+ (progn (dired-update-file-line new-file) nil)
+ (dired-log (concat "Failed to compress" from-file))
+ from-file)))
+
+(defun dired-compress-file (file)
+ ;; Compress or uncompress FILE.
+ ;; Return the name of the compressed or uncompressed file.
+ ;; Rerurn nil if no change in files.
+ (let ((handler (find-file-name-handler file)))
+ (cond (handler
+ (funcall handler 'dired-compress-file file))
+ ((file-symlink-p file)
+ nil)
+ ((let (case-fold-search)
+ (string-match "\\.Z$" file))
+ (if (not (dired-check-process (concat "Uncompressing " file)
+ "uncompress" file))
+ (substring file 0 -2)))
+ ((let (case-fold-search)
+ (string-match "\\.gz$" file))
+ (if (not (dired-check-process (concat "Uncompressing " file)
+ "gunzip" file))
+ (substring file 0 -3)))
(t
- (if (dired-check-process (concat "Compressing " from-file)
- "compress" "-f" from-file)
- ;; Errors from the process are already logged.
- (dired-make-relative from-file)
- (dired-update-file-line (concat from-file ".Z")))))
- nil))
+ ;;; Try gzip; if we don't have that, use compress.
+ (condition-case nil
+ (if (not (dired-check-process (concat "Compressing " file)
+ "gzip" "-f" file))
+ (concat file ".gz"))
+ (file-error
+ (if (not (dired-check-process (concat "Compressing " file)
+ "compress" "-f" file))
+ (concat file ".Z"))))))))
\f
(defun dired-mark-confirm (op-symbol arg)
;; Request confirmation from the user that the operation described
;; pop-up unless OP-SYMBOL is a member of `dired-no-confirm'.
;; The files used are determined by ARG (as in dired-get-marked-files).
(or (memq op-symbol dired-no-confirm)
- (let ((files (dired-get-marked-files t arg)))
+ (let ((files (dired-get-marked-files t arg))
+ (string (if (eq op-symbol 'compress) "Compress or uncompress"
+ (capitalize (symbol-name op-symbol)))))
(dired-mark-pop-up nil op-symbol files (function y-or-n-p)
- (concat (capitalize (symbol-name op-symbol)) " "
+ (concat string " "
(dired-mark-prompt arg files) "? ")))))
(defun dired-map-over-marks-check (fun arg op-symbol &optional show-progress)
(dired-map-over-marks (funcall fun) arg show-progress))
(total (length total-list))
(failures (delq nil total-list))
- (count (length failures)))
+ (count (length failures))
+ (string (if (eq op-symbol 'compress) "Compress or uncompress"
+ (capitalize (symbol-name op-symbol)))))
(if (not failures)
(message "%s: %d file%s."
- (capitalize (symbol-name op-symbol))
- total (dired-plural-s total))
+ string total (dired-plural-s total))
;; end this bunch of errors:
(dired-log-summary
(format "Failed to %s %d of %d file%s"
- (symbol-name op-symbol) count total (dired-plural-s total))
+ (downcase string) count total (dired-plural-s total))
failures)))))
(defvar dired-query-alist
;; Query user and return nil or t.
;; Store answer in symbol VAR (which must initially be bound to nil).
;; Format PROMPT with ARGS.
- ;; Binding variable help-form will help the user who types C-h.
+ ;; Binding variable help-form will help the user who types the help key.
(let* ((char (symbol-value qs-var))
(action (cdr (assoc char dired-query-alist))))
(cond ((eq 'yes action)
(let (buffer-read-only)
(beginning-of-line)
(dired-add-entry-do-indentation marker-char)
- (dired-ls (dired-make-absolute filename directory);; don't expand `.' !
- (concat dired-actual-switches "d"))
+ ;; don't expand `.' !
+ (insert-directory (dired-make-absolute filename directory)
+ (concat dired-actual-switches "d"))
(forward-line -1)
;; We want to have the non-directory part, only:
(let* ((beg (dired-move-to-filename t)) ; error for strange output
(if whole-path nil current-prefix-arg))
(regexp
(dired-read-regexp
- (concat (if whole-path "Path " "") operation " from (regexp): ")
- dired-flagging-regexp))
+ (concat (if whole-path "Path " "") operation " from (regexp): ")))
(newname
(read-string
(concat (if whole-path "Path " "") operation " " regexp " to: "))))
(if (equal dirname (car (car (reverse dired-subdir-alist))))
;; top level directory may contain wildcards:
(dired-readin-insert dired-directory)
- (dired-ls dirname dired-actual-switches nil t)))
+ (insert-directory dirname dired-actual-switches nil t)))
(message "Reading directory %s...done" dirname)
(setq end (point-marker))
(indent-rigidly begin end 2)
\f
;;; moving by subdirectories
-(defun dired-subdir-index (dir)
- ;; Return an index into alist for use with nth
- ;; for the sake of subdir moving commands.
- (let (found (index 0) (alist dired-subdir-alist))
- (while alist
- (if (string= dir (car (car alist)))
- (setq alist nil found t)
- (setq alist (cdr alist) index (1+ index))))
- (if found index nil)))
-
-;;;###autoload
-(defun dired-next-subdir (arg &optional no-error-if-not-found no-skip)
- "Go to next subdirectory, regardless of level."
- ;; Use 0 arg to go to this directory's header line.
- ;; NO-SKIP prevents moving to end of header line, returning whatever
- ;; position was found in dired-subdir-alist.
- (interactive "p")
- (let ((this-dir (dired-current-directory))
- pos index)
- ;; nth with negative arg does not return nil but the first element
- (setq index (- (dired-subdir-index this-dir) arg))
- (setq pos (if (>= index 0)
- (dired-get-subdir-min (nth index dired-subdir-alist))))
- (if pos
- (progn
- (goto-char pos)
- (or no-skip (skip-chars-forward "^\n\r"))
- (point))
- (if no-error-if-not-found
- nil ; return nil if not found
- (error "%s directory" (if (> arg 0) "Last" "First"))))))
-
;;;###autoload
(defun dired-prev-subdir (arg &optional no-error-if-not-found no-skip)
"Go to previous subdirectory, regardless of level.