Function: tramp-sh-handle-dired-compress-file

tramp-sh-handle-dired-compress-file is a byte-compiled function defined in tramp-sh.el.gz.

Signature

(tramp-sh-handle-dired-compress-file FILE)

Documentation

Like dired-compress-file for Tramp files.

Source Code

;; Defined in /usr/src/emacs/lisp/net/tramp-sh.el.gz
;; Dired.

(defun tramp-sh-handle-dired-compress-file (file)
  "Like `dired-compress-file' for Tramp files."
  ;; Starting with Emacs 29.1, `dired-compress-file' is performed by
  ;; default handler.
  (if (>= emacs-major-version 29)
      (tramp-run-real-handler #'dired-compress-file (list file))
    ;; Code stolen mainly from dired-aux.el.
    (with-parsed-tramp-file-name (expand-file-name file) nil
      (tramp-flush-file-properties v localname)
      (let ((suffixes dired-compress-file-suffixes)
	    suffix)
	;; See if any suffix rule matches this file name.
	(while suffixes
	  (let (case-fold-search)
	    (if (string-match-p (car (car suffixes)) localname)
		(setq suffix (car suffixes) suffixes nil))
	    (setq suffixes (cdr suffixes))))

	(cond ((file-symlink-p file) nil)
	      ((and suffix (nth 2 suffix))
	       ;; We found an uncompression rule.
	       (with-tramp-progress-reporter
                   v 0 (format "Uncompressing %s" file)
		 (when (tramp-send-command-and-check
			v (if (string-match-p (rx "%" (any "io")) (nth 2 suffix))
                              (replace-regexp-in-string
                               "%i" (tramp-shell-quote-argument localname)
                               (nth 2 suffix))
                            (concat (nth 2 suffix) " "
                                    (tramp-shell-quote-argument localname))))
		   (unless (string-match-p "\\.tar\\.gz" file)
                     (dired-remove-file file))
		   (string-match (car suffix) file)
		   (concat (substring file 0 (match-beginning 0))))))
	      (t
	       ;; We don't recognize the file as compressed, so
	       ;; compress it.  Try gzip.
	       (with-tramp-progress-reporter v 0 (format "Compressing %s" file)
		 (when (tramp-send-command-and-check
			v (if (file-directory-p file)
                              (format "tar -cf - %s | gzip -c9 > %s.tar.gz"
                                      (tramp-shell-quote-argument
                                       (file-name-nondirectory localname))
                                      (tramp-shell-quote-argument localname))
                            (concat "gzip -f "
				    (tramp-shell-quote-argument localname))))
		   (unless (file-directory-p file)
                     (dired-remove-file file))
		   (catch 'found nil
                          (dolist (target (mapcar (lambda (suffix)
                                                    (concat file suffix))
                                                  '(".tar.gz" ".gz" ".z")))
                            (when (file-exists-p target)
                              (throw 'found target))))))))))))