Function: dired-compress-file

dired-compress-file is an autoloaded and byte-compiled function defined in dired-aux.el.gz.

Signature

(dired-compress-file FILE)

Documentation

Compress or uncompress FILE.

Return the name of the compressed or uncompressed file. Return nil if no change in files.

Source Code

;; Defined in /usr/src/emacs/lisp/dired-aux.el.gz
;;;###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)
        command)
    ;; 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 (setq command (nth 2 suffix)))
           (if (string-match "%[io]" command)
               (prog1 (setq newname (file-name-as-directory newname))
                 (dired-shell-command
                  (replace-regexp-in-string
                   "%o" (shell-quote-argument newname)
                   (replace-regexp-in-string
                    "%i" (shell-quote-argument file)
                    command
                    nil t)
                   nil t)))
             ;; We found an uncompression rule.
             (let ((match (string-search " " command))
                   (msg (concat "Uncompressing " file)))
               (unless (if match
                           (dired-check-process msg
                                                (substring command 0 match)
                                                (substring command (1+ match))
                                                file)
                         (dired-check-process msg
                                              command
                                              file))
                 newname))))
          (t
           ;; We don't recognize the file as compressed, so compress it.
           ;; Try gzip; if we don't have that, use compress.
           (condition-case nil
               (if (file-directory-p file)
                   (let* ((suffix
                           (or dired-compress-directory-default-suffix
                               ".tar.gz"))
                          (rule (cl-find-if
                                 (lambda (x) (string-match-p (car x) suffix))
                                 dired-compress-files-alist)))
                     (if rule
                         (let ((out-name (concat file suffix))
                               (default-directory (file-name-directory file)))
                           (dired-shell-command
                            (replace-regexp-in-string
                             "%o" (shell-quote-argument out-name)
                             (replace-regexp-in-string
                              "%i" (shell-quote-argument
                                    (file-name-nondirectory file))
                              (cdr rule)
                              nil t)
                             nil t))
                           out-name)
                       (user-error
                        "No compression rule found for \
`dired-compress-directory-default-suffix' %s, see `dired-compress-files-alist' for\
 the supported suffixes list"
                        dired-compress-directory-default-suffix)))
                 (let* ((suffix (or dired-compress-file-default-suffix ".gz"))
                        (out-name (concat file suffix))
                        (rule (cl-find-if
                               (lambda (x) (string-match-p (car x) suffix))
                               dired-compress-file-alist)))
                   (if (not rule)
                       (user-error "No compression rule found for suffix %s, \
see `dired-compress-file-alist' for the supported suffixes list"
                                   dired-compress-file-default-suffix)
                     (and (file-exists-p file)
                          (or (not (file-exists-p out-name))
                              (y-or-n-p
                               (format
                                "File %s already exists.  Really compress? "
                                out-name)))
                          (dired-shell-command
                           (replace-regexp-in-string
                            "%o" (shell-quote-argument out-name)
                            (replace-regexp-in-string
                             "%i" (shell-quote-argument file)
                             (cdr rule)
                             nil t)
                            nil t))
                          (or (file-exists-p out-name)
                              (setq out-name (concat file ".z")))
                          ;; Rename the compressed file to NEWNAME
                          ;; if it hasn't got that name already.
                          (if (and newname (not (equal newname out-name)))
                              (progn
                                (rename-file out-name newname t)
                                newname)
                            out-name)))))
             (file-error
              (if (not (dired-check-process (concat "Compressing " file)
                                            "compress" "-f" file))
                  ;; Don't use NEWNAME with `compress'.
                  (concat file ".Z"))))))))