Skip to content

Instantly share code, notes, and snippets.

@cpbotha

cpbotha/archive-extract-to-file.el

Last active July 26, 2018 10:36
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save cpbotha/05e07dee7fd8243ba73339be186c0b88 to your computer and use it in GitHub Desktop.
Save cpbotha/05e07dee7fd8243ba73339be186c0b88 to your computer and use it in GitHub Desktop.
Download ZIP
Raw
archive-extract-to-file.el
;; https://emacs.stackexchange.com/a/3843/8743 original code
;; cpbotha.net made small improvements to ergonomics
;; cpbotha changes:
;; - by default extract files WITHOUT their relative directories into DIR,
;; because that's what I expect in OFMs.
(defun archive-extract-to-file (archive-name item-name command dir keep-relpath)
"Extract ITEM-NAME from ARCHIVE-NAME using COMMAND. Save to
DIR. If KEEP-RELPATH, extract with relative path otherwise don't."
(unwind-protect
(let* ((file-name (if keep-relpath
;; remove the leading / from the file name to force
;; expand-file-name to interpret its path as relative to dir
(if (string-match "\\`/" item-name)
(substring item-name 1)
item-name)
;; by default just strip the path completely
(file-name-nondirectory item-name)))
(output-file (expand-file-name file-name dir))
(output-dir (file-name-directory output-file)))
;; create the output directory (and its parents) if it does
;; not exist yet
(unless (file-directory-p output-dir)
(make-directory output-dir t))
;; execute COMMAND, redirecting output to output-file
(apply #'call-process
(car command) ;program
nil ;infile
`(:file ,output-file) ;destination
nil ;display
(append (cdr command) (list archive-name item-name))))
;; FIXME: add unwind forms
nil))
;; cpbotha changes:
;; - extract to OTHER dired pane, OR to directory containing archive if there
;; is no other dired pane
(defun archive-extract-marked-to-file (keep-relpath)
"Extract marked archive items to OUTPUT-DIR. If KEEP-RELPATH is non-nil
or prefix-arg (C-u) is set, keep relative paths of files in archive,
otherwise don't."
(interactive "P")
(let ((output-dir (or (dired-dwim-target-directory) default-directory))
(command (symbol-value (archive-name "extract")))
(archive (buffer-file-name))
(items (archive-get-marked ?* t))) ; get marked items; t means
; get item under point if
; nothing is marked
(mapc
(lambda (item)
(archive-extract-to-file archive
(aref item 0) ; get the name from the descriptor
command output-dir keep-relpath))
items)))
(provide 'archive-extract-to-file)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment