diff options
Diffstat (limited to 'lisp/tar-mode.el')
| -rw-r--r-- | lisp/tar-mode.el | 130 |
1 files changed, 57 insertions, 73 deletions
diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el index a73fa917e4b..cf777817666 100644 --- a/lisp/tar-mode.el +++ b/lisp/tar-mode.el @@ -1,4 +1,4 @@ -;;; tar-mode.el --- simple editing of tar files from GNU Emacs +;;; tar-mode.el --- simple editing of tar files from GNU Emacs -*- lexical-binding:t -*- ;; Copyright (C) 1990-1991, 1993-2019 Free Software Foundation, Inc. @@ -95,6 +95,7 @@ ;;; Code: (eval-when-compile (require 'cl-lib)) +(require 'arc-mode) (defgroup tar nil "Simple editing of tar files." @@ -109,8 +110,7 @@ this is the size of the *tape* blocks, but when writing to a file, it doesn't matter much. The only noticeable difference is that if a tar file does not have a blocksize of 20, tar will tell you that; all this really controls is how many null padding bytes go on the end of the tar file." - :type '(choice integer (const nil)) - :group 'tar) + :type '(choice integer (const nil))) (defcustom tar-update-datestamp nil "Non-nil means Tar mode should play fast and loose with sub-file datestamps. @@ -120,14 +120,12 @@ You may or may not want this - it is good in that you can tell when a file in a tar archive has been changed, but it is bad for the same reason that editing a file in the tar archive at all is bad - the changed version of the file never exists on disk." - :type 'boolean - :group 'tar) + :type 'boolean) (defcustom tar-mode-show-date nil "Non-nil means Tar mode should show the date/time of each subfile. This information is useful, but it takes screen space away from file names." - :type 'boolean - :group 'tar) + :type 'boolean) (defvar tar-parse-info nil) (defvar tar-superior-buffer nil @@ -265,11 +263,10 @@ write-date, checksum, link-type, and link-name." (setq name (concat (substring string tar-prefix-offset (1- (match-end 0))) "/" name))) - (if (default-value 'enable-multibyte-characters) - (setq name - (decode-coding-string name coding) - linkname - (decode-coding-string linkname coding))) + (setq name + (decode-coding-string name coding) + linkname + (decode-coding-string linkname coding)) (if (and (null link-p) (string-match "/\\'" name)) (setq link-p 5)) ; directory @@ -305,7 +302,7 @@ write-date, checksum, link-type, and link-name." (tar-parse-octal-integer string tar-uid-offset tar-gid-offset) (tar-parse-octal-integer string tar-gid-offset tar-size-offset) (tar-parse-octal-integer string tar-size-offset tar-time-offset) - (tar-parse-octal-long-integer string tar-time-offset tar-chk-offset) + (tar-parse-octal-integer string tar-time-offset tar-chk-offset) (tar-parse-octal-integer string tar-chk-offset tar-linkp-offset) link-p linkname @@ -343,20 +340,8 @@ write-date, checksum, link-type, and link-name." start (1+ start))) n))) -(defun tar-parse-octal-long-integer (string &optional start end) - (if (null start) (setq start 0)) - (if (null end) (setq end (length string))) - (if (= (aref string start) 0) - (list 0 0) - (let ((lo 0) - (hi 0)) - (while (< start end) - (if (>= (aref string start) ?0) - (setq lo (+ (* lo 8) (- (aref string start) ?0)) - hi (+ (* hi 8) (ash lo -16)) - lo (logand lo 65535))) - (setq start (1+ start))) - (list hi lo)))) +(define-obsolete-function-alias 'tar-parse-octal-long-integer + #'tar-parse-octal-integer "27.1") (defun tar-parse-octal-integer-safe (string) (if (zerop (length string)) (error "empty string")) @@ -535,30 +520,38 @@ MODE should be an integer which is a file mode value." "Extract all archive members in the tar-file into the current directory." (interactive) ;; FIXME: make it work even if we're not in tar-mode. - (let ((descriptors tar-parse-info)) ;Read the var in its buffer. - (with-current-buffer - (if (tar-data-swapped-p) tar-data-buffer (current-buffer)) - (set-buffer-multibyte nil) ;Hopefully, a no-op. - (dolist (descriptor descriptors) - (let* ((name (tar-header-name descriptor)) - (dir (if (eq (tar-header-link-type descriptor) 5) - name - (file-name-directory name))) - (link-desc (tar--describe-as-link descriptor)) - (start (tar-header-data-start descriptor)) - (end (+ start (tar-header-size descriptor)))) + (let ((data-buf (if (tar-data-swapped-p) tar-data-buffer + (current-buffer))) + (reporter (make-progress-reporter "Extracting"))) + (with-current-buffer data-buf + (cl-assert (not enable-multibyte-characters))) + (dolist (descriptor tar-parse-info) + (let* ((orig (tar-header-name descriptor)) + ;; Note that default-directory may have different values + ;; in the tar-mode and data buffers, so we stick to the + ;; absolute file name from now on. + (name (expand-file-name orig)) + (dir (if (eq (tar-header-link-type descriptor) 5) + name + (file-name-directory name))) + (link-desc (tar--describe-as-link descriptor)) + (start (tar-header-data-start descriptor)) + (end (+ start (tar-header-size descriptor)))) + (unless (file-directory-p name) + (progress-reporter-update reporter name) + (if (and dir (not (file-exists-p dir))) + (make-directory dir t)) (unless (file-directory-p name) - (message "Extracting %s" name) - (if (and dir (not (file-exists-p dir))) - (make-directory dir t)) - (unless (file-directory-p name) - (let ((coding-system-for-write 'no-conversion)) + (with-current-buffer data-buf + (let ((coding-system-for-write 'no-conversion) + (write-region-inhibit-fsync t)) (when link-desc (lwarn '(tar link) :warning "Extracted `%s', %s, as a normal file" name link-desc)) - (write-region start end name))) - (set-file-modes name (tar-header-mode descriptor)))))))) + (write-region start end name nil :nomessage))) + (set-file-modes name (tar-header-mode descriptor)))))) + (progress-reporter-done reporter))) (defun tar-summarize-buffer () "Parse the contents of the tar file in the current buffer." @@ -596,10 +589,10 @@ MODE should be an integer which is a file mode value." (progress-reporter-done progress-reporter) (message "Warning: premature EOF parsing tar file")) (goto-char (point-min)) - (let ((buffer-file-truename nil) ; avoid changing dir mtime by lock_file + (let ((create-lockfiles nil) ; avoid changing dir mtime by lock_file (inhibit-read-only t) (total-summaries - (mapconcat 'tar-header-block-summarize tar-parse-info "\n"))) + (mapconcat #'tar-header-block-summarize tar-parse-info "\n"))) (insert total-summaries "\n") (goto-char (point-min)) (restore-buffer-modified-p modified)))) @@ -733,13 +726,13 @@ See also: variables `tar-update-datestamp' and `tar-anal-blocksize'. ;; Now move the Tar data into an auxiliary buffer, so we can use the main ;; buffer for the summary. (cl-assert (not (tar-data-swapped-p))) - (set (make-local-variable 'revert-buffer-function) 'tar-mode-revert) + (set (make-local-variable 'revert-buffer-function) #'tar-mode-revert) ;; We started using write-contents-functions, but this hook is not ;; used during auto-save, so we now use ;; write-region-annotate-functions which hooks at a lower-level. - (add-hook 'write-region-annotate-functions 'tar-write-region-annotate nil t) - (add-hook 'kill-buffer-hook 'tar-mode-kill-buffer-hook nil t) - (add-hook 'change-major-mode-hook 'tar-change-major-mode-hook nil t) + (add-hook 'write-region-annotate-functions #'tar-write-region-annotate nil t) + (add-hook 'kill-buffer-hook #'tar-mode-kill-buffer-hook nil t) + (add-hook 'change-major-mode-hook #'tar-change-major-mode-hook nil t) ;; Tar data is made of bytes, not chars. (set-buffer-multibyte nil) ;Hopefully a no-op. (set (make-local-variable 'tar-data-buffer) @@ -763,24 +756,22 @@ See also: variables `tar-update-datestamp' and `tar-anal-blocksize'. (define-minor-mode tar-subfile-mode "Minor mode for editing an element of a tar-file. -With a prefix argument ARG, enable the mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil. This mode arranges for \"saving\" this -buffer to write the data into the tar-file buffer that it came -from. The changes will actually appear on disk when you save the -tar-file's buffer." + +This mode arranges for \"saving\" this buffer to write the data +into the tar-file buffer that it came from. The changes will +actually appear on disk when you save the tar-file's buffer." ;; Don't do this, because it is redundant and wastes mode line space. ;; :lighter " TarFile" nil nil nil (or (and (boundp 'tar-superior-buffer) tar-superior-buffer) (error "This buffer is not an element of a tar file")) (cond (tar-subfile-mode - (add-hook 'write-file-functions 'tar-subfile-save-buffer nil t) + (add-hook 'write-file-functions #'tar-subfile-save-buffer nil t) ;; turn off auto-save. (auto-save-mode -1) (setq buffer-auto-save-file-name nil)) (t - (remove-hook 'write-file-functions 'tar-subfile-save-buffer t)))) + (remove-hook 'write-file-functions #'tar-subfile-save-buffer t)))) ;; Revert the buffer and recompute the dired-like listing. @@ -907,8 +898,7 @@ tar-file's buffer." (if (or (not coding) (eq (coding-system-type coding) 'undecided)) (setq coding (detect-coding-region start end t))) - (if (and (default-value 'enable-multibyte-characters) - (coding-system-get coding :for-unibyte)) + (if (coding-system-get coding :for-unibyte) (with-current-buffer buffer (set-buffer-multibyte nil))) (widen) @@ -947,6 +937,7 @@ tar-file's buffer." (setq buffer-file-name new-buffer-file-name) (setq buffer-file-truename (abbreviate-file-name buffer-file-name)) + (archive-try-jka-compr) ;Pretty ugly hack :-( ;; Force buffer-file-coding-system to what ;; decode-coding-region actually used. (set-buffer-file-coding-system last-coding-system-used t) @@ -1036,8 +1027,7 @@ the current tar-entry." (defun tar-new-entry (filename &optional index) "Insert a new empty regular file before point." (interactive "*sFile name: ") - (let* ((buffer (current-buffer)) - (index (or index (tar-current-position))) + (let* ((index (or index (tar-current-position))) (d-list (and (not (zerop index)) (nthcdr (+ -1 index) tar-parse-info))) (pos (if d-list @@ -1069,7 +1059,7 @@ the current tar-entry." With a prefix argument, mark that many files." (interactive "p") (beginning-of-line) - (dotimes (i (abs p)) + (dotimes (_ (abs p)) (if (tar-current-descriptor unflag) ; barf if we're not on an entry-line. (progn (delete-char 1) @@ -1280,14 +1270,8 @@ for this to be permanent." (defun tar-octal-time (timeval) - ;; Format a timestamp as 11 octal digits. Ghod, I hope this works... - (let ((hibits (car timeval)) (lobits (car (cdr timeval)))) - (format "%05o%01o%05o" - (lsh hibits -2) - (logior (lsh (logand 3 hibits) 1) - (if (> (logand lobits 32768) 0) 1 0)) - (logand 32767 lobits) - ))) + ;; Format a timestamp as 11 octal digits. + (format "%011o" (encode-time timeval 'integer))) (defun tar-subfile-save-buffer () "In tar subfile mode, save this buffer into its parent tar-file buffer. |