- (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
+ (let ((start (point)))
+ ;; Remove any preexisting entry for the name NEW-FILE.
+ (condition-case nil
+ (dired-remove-entry new-file)
+ (error nil))
+ (goto-char start)
+ ;; Now replace the current line with an entry for NEW-FILE.
+ (dired-update-file-line new-file) nil)
+ (dired-log (concat "Failed to compress" from-file))
+ from-file)))
+
+(defvar dired-compress-file-suffixes
+ '(("\\.gz\\'" "" "gunzip")
+ ("\\.tgz\\'" ".tar" "gunzip")
+ ("\\.Z\\'" "" "uncompress")
+ ;; For .z, try gunzip. It might be an old gzip file,
+ ;; or it might be from compact? pack? (which?) but gunzip handles both.
+ ("\\.z\\'" "" "gunzip")
+ ("\\.bz2\\'" "" "bunzip2")
+ ;; This item controls naming for compression.
+ ("\\.tar\\'" ".tgz" nil))
+ "Control changes in file name suffixes for compression and uncompression.
+Each element specifies one transformation rule, and has the form:
+ (REGEXP NEW-SUFFIX PROGRAM)
+The rule applies when the old file name matches REGEXP.
+The new file name is computed by deleting the part that matches REGEXP
+ (as well as anything after that), then adding NEW-SUFFIX in its place.
+If PROGRAM is non-nil, the rule is an uncompression rule,
+and uncompression is done by running PROGRAM.
+Otherwise, the rule is a compression rule, and compression is done with gzip.")
+
+;;;###autoload
+(defun dired-compress-file (file)
+ ;; Compress or uncompress FILE.
+ ;; Return the name of the compressed or uncompressed file.
+ ;; Return nil if no change in files.
+ (let ((handler (find-file-name-handler file 'dired-compress-file))
+ suffix newname
+ (suffixes dired-compress-file-suffixes))
+ ;; See if any suffix rule matches this file name.
+ (while suffixes
+ (let (case-fold-search)
+ (if (string-match (car (car suffixes)) file)
+ (setq suffix (car suffixes) suffixes nil))
+ (setq suffixes (cdr suffixes))))
+ ;; If so, compute desired new name.
+ (if suffix
+ (setq newname (concat (substring file 0 (match-beginning 0))
+ (nth 1 suffix))))
+ (cond (handler
+ (funcall handler 'dired-compress-file file))
+ ((file-symlink-p file)
+ nil)
+ ((and suffix (nth 2 suffix))
+ ;; We found an uncompression rule.
+ (if (not (dired-check-process (concat "Uncompressing " file)
+ (nth 2 suffix) file))
+ newname))