Function: archive-extract

archive-extract is an interactive and byte-compiled function defined in arc-mode.el.gz.

Signature

(archive-extract &optional OTHER-WINDOW-P EVENT)

Documentation

In archive mode, extract this entry of the archive into its own buffer.

Key Bindings

Source Code

;; Defined in /usr/src/emacs/lisp/arc-mode.el.gz
(defun archive-extract (&optional other-window-p event)
  "In archive mode, extract this entry of the archive into its own buffer."
  (interactive (list nil last-input-event) archive-mode)
  (if event (posn-set-point (event-end event)))
  (let* ((view-p (eq other-window-p 'view))
	 (descr (archive-get-descr))
         (ename (archive--file-desc-ext-file-name descr))
         (iname (archive--file-desc-int-file-name descr))
         (archive-buffer (current-buffer))
         (arcdir default-directory)
         (archive (buffer-file-name))
         (arcname (file-name-nondirectory archive))
         (bufname (concat (file-name-nondirectory iname) " (" arcname ")"))
         (extractor (archive-name "extract"))
	 ;; Members with file names which aren't valid for the
	 ;; underlying filesystem, are treated as read-only.
         (read-only-p (or archive-read-only
			  view-p
			  (string-match file-name-invalid-regexp ename)))
	 (arcfilename (expand-file-name (concat arcname ":" iname)))
         (buffer (get-buffer bufname))
         (just-created nil)
	 (file-name-coding archive-file-name-coding-system))
      (or archive-remote
          (and (local-variable-p 'tar-archive-from-tar)
               (setq archive-remote tar-archive-from-tar)))
      (if (and buffer
	       (string= (buffer-file-name buffer) arcfilename))
          nil
	(setq archive (archive-maybe-copy archive))
	(setq bufname (generate-new-buffer-name bufname))
        (setq buffer (get-buffer-create bufname))
        (setq just-created t)
        (with-current-buffer buffer
          (setq buffer-file-name arcfilename)
          (setq buffer-file-truename
                (abbreviate-file-name buffer-file-name))
          ;; Set the default-directory to the dir of the superior buffer.
          (setq default-directory arcdir)
          (setq-local archive-superior-buffer archive-buffer)
          (add-hook 'write-file-functions #'archive-write-file-member nil t)
          (setq archive-subfile-mode descr)
	  (setq archive-file-name-coding-system file-name-coding)
	  (if (and
	       (null (archive--extract-file extractor archive ename))
	       just-created)
	      (progn
		(set-buffer-modified-p nil)
		(kill-buffer buffer))
            (archive-try-jka-compr)     ;Pretty ugly hack :-(
	    (archive-set-buffer-as-visiting-file ename)
	    (goto-char (point-min))
	    (rename-buffer bufname)
	    (setq buffer-read-only read-only-p)
	    (setq buffer-undo-list nil)
	    (set-buffer-modified-p nil)
	    (setq buffer-saved-size (buffer-size))
	    (normal-mode)
	    ;; Just in case an archive occurs inside another archive.
	    (when (derived-mode-p 'archive-mode)
              (setq archive-remote t)
              (if read-only-p (setq archive-read-only t))
              ;; We will write out the archive ourselves if it is
              ;; part of another archive.
              (remove-hook 'write-contents-functions #'archive-write-file t))
            (run-hooks 'archive-extract-hook)
	    (if archive-read-only
		(message "Note: altering this archive is not implemented."))))
	(archive-maybe-update t))
      (or (not (buffer-name buffer))
          (cond
           (view-p
	    (view-buffer buffer (and just-created 'kill-buffer-if-not-modified)))
           ((eq other-window-p 'display) (display-buffer buffer))
           (other-window-p (switch-to-buffer-other-window buffer))
           (t (switch-to-buffer buffer))))))