From d26e6665bf487689a0e44c0b601effe25d8b71f3 Mon Sep 17 00:00:00 2001 From: Kenichi Handa Date: Wed, 31 Jul 2002 07:14:35 +0000 Subject: [PATCH] (tar-file-name-coding-system): New variable. Make it permanent-local.p (tar-header-block-tokenize): Decode filename and linkname by tar-file-name-coding-system. (tar-header-block-checksum): Call multibyte-char-to-unibyte to get the byte value of eight-bit chars. (tar-summarize-buffer): Call set-buffer-multibyte with METHOD `to'. Delete unnecessary call of position-bytes. (tar-mode): Set tar-file-name-coding-system. Delete unnecessary call of position-bytes. (tar-extract): Simplified by calling decode-coding-region with DESTINATION argument. Don't toggle multibyteness of tar buffer. (tar-copy): Don't toggle multibyteness of tar buffer. (tar-expunge): Likewise. (tar-clear-modification-flags): Delete unnecessary call of position-bytes. (tar-rename-entry): Call tar-alter-one-field with encoded new name. (tar-alter-one-field): Don't toggle multibyteness of tar buffer. Convert new-data-string by string-to-multibyte before inserting it. (tar-subfile-save-buffer): Don't toggle multibyteness of tar buffer. Simplified by calling encoding-coding-region with DESTINATION argument. (tar-mode-write-file): Delete unnecessary call of byte-to-position. --- lisp/tar-mode.el | 182 +++++++++++++++++++---------------------------- 1 file changed, 75 insertions(+), 107 deletions(-) diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el index 2bfd75c7630..bd10737b548 100644 --- a/lisp/tar-mode.el +++ b/lisp/tar-mode.el @@ -129,16 +129,17 @@ This information is useful, but it takes screen space away from file names." :group 'tar) (defvar tar-parse-info nil) -;; Be sure that this variable holds byte position, not char position. (defvar tar-header-offset nil) (defvar tar-superior-buffer nil) (defvar tar-superior-descriptor nil) (defvar tar-subfile-mode nil) +(defvar tar-file-name-coding-system nil) (put 'tar-parse-info 'permanent-local t) (put 'tar-header-offset 'permanent-local t) (put 'tar-superior-buffer 'permanent-local t) (put 'tar-superior-descriptor 'permanent-local t) +(put 'tar-file-name-coding-system 'permanent-local t) (defmacro tar-setf (form val) "A mind-numbingly simple implementation of setf." @@ -231,11 +232,10 @@ write-date, checksum, link-type, and link-name." (setq linkname (substring string tar-link-offset link-end)) (if default-enable-multibyte-characters (setq name - (decode-coding-string name (or file-name-coding-system - 'undecided)) + (decode-coding-string name tar-file-name-coding-system) linkname - (decode-coding-string linkname (or file-name-coding-system - 'undecided)))) + (decode-coding-string linkname + tar-file-name-coding-system))) (if (and (null link-p) (string-match "/$" name)) (setq link-p 5)) ; directory (make-tar-header name @@ -302,11 +302,11 @@ write-date, checksum, link-type, and link-name." ;; Add up all of the characters except the ones in the checksum field. ;; Add that field as if it were filled with spaces. (while (< i chk-field-start) - (setq sum (+ sum (aref string i)) + (setq sum (+ sum (multibyte-char-to-unibyte (aref string i))) i (1+ i))) (setq i chk-field-end) (while (< i 512) - (setq sum (+ sum (aref string i)) + (setq sum (+ sum (multibyte-char-to-unibyte (aref string i))) i (1+ i))) (+ sum (* 32 8)))) @@ -434,15 +434,13 @@ is visible (and the real data of the buffer is hidden)." (cons (tar-header-block-summarize (tar-desc-tokens tar-desc)) (cons "\n" summaries)))) + (if default-enable-multibyte-characters + (set-buffer-multibyte t 'to)) (let ((total-summaries (apply 'concat summaries))) - (if (multibyte-string-p total-summaries) - (set-buffer-multibyte t)) (insert total-summaries)) (make-local-variable 'tar-header-offset) (setq tar-header-offset (point)) (narrow-to-region 1 tar-header-offset) - (if enable-multibyte-characters - (setq tar-header-offset (position-bytes tar-header-offset))) (set-buffer-modified-p nil)))) (defvar tar-mode-map nil "*Local keymap for Tar mode listings.") @@ -553,13 +551,17 @@ See also: variables `tar-update-datestamp' and `tar-anal-blocksize'. (set (make-local-variable 'revert-buffer-function) 'tar-mode-revert) (set (make-local-variable 'local-enable-local-variables) nil) (set (make-local-variable 'next-line-add-newlines) nil) + (set (make-local-variable 'tar-file-name-coding-system) + (or file-name-coding-system + default-file-name-coding-system + locale-coding-system)) ;; Prevent loss of data when saving the file. (set (make-local-variable 'file-precious-flag) t) (auto-save-mode 0) (set (make-local-variable 'write-contents-hooks) '(tar-mode-write-file)) (widen) (if (and (boundp 'tar-header-offset) tar-header-offset) - (narrow-to-region 1 (byte-to-position tar-header-offset)) + (narrow-to-region 1 tar-header-offset) (tar-summarize-buffer) (tar-next-line 0))) @@ -681,61 +683,40 @@ appear on disk when you save the tar-file's buffer." ;; `:' is not allowed on Windows (concat tarname "!" name))) (buffer (get-file-buffer new-buffer-file-name)) - (just-created nil)) + (just-created nil) + (pos (point))) (unless buffer (setq buffer (generate-new-buffer bufname)) (setq bufname (buffer-name buffer)) (setq just-created t) (unwind-protect - (progn - (widen) - (set-buffer-multibyte nil) + (let (coding) + (narrow-to-region start end) + (goto-char start) + (setq coding (or coding-system-for-read + (and set-auto-coding-function + (funcall set-auto-coding-function + name (point-max))))) + (if (or (not coding) + (eq (coding-system-type coding) 'undecided)) + (setq coding (detect-coding-region start end t))) + (if (eq (coding-system-type coding) 'undecided) + (setq coding + (coding-system-change-text-conversion coding + 'us-ascii))) (save-excursion (set-buffer buffer) - (if enable-multibyte-characters - (progn - ;; We must avoid unibyte->multibyte conversion. - (set-buffer-multibyte nil) - (insert-buffer-substring tar-buffer start end) - (set-buffer-multibyte t)) - (insert-buffer-substring tar-buffer start end)) + (if (and enable-multibyte-characters + (eq (coding-system-type 'raw-text) coding)) + (set-buffer-multibyte nil)) (goto-char (point-min)) (setq buffer-file-name new-buffer-file-name) (setq buffer-file-truename - (abbreviate-file-name buffer-file-name)) - ;; We need to mimic the parts of insert-file-contents - ;; which determine the coding-system and decode the text. - (let ((coding - (or coding-system-for-read - (and set-auto-coding-function - (save-excursion - (funcall set-auto-coding-function - name (- (point-max) (point))))))) - (multibyte enable-multibyte-characters) - (detected (detect-coding-region - 1 (min 16384 (point-max)) t))) - (if coding - (or (numberp (coding-system-eol-type coding)) - (setq coding (coding-system-change-eol-conversion - coding - (coding-system-eol-type detected)))) - (setq coding - (or (find-new-buffer-file-coding-system detected) - (let ((file-coding - (find-operation-coding-system - 'insert-file-contents buffer-file-name))) - (if (consp file-coding) - (setq file-coding (car file-coding)) - file-coding))))) - (if (or (eq coding 'no-conversion) - (eq (coding-system-type coding) 5)) - (setq multibyte (set-buffer-multibyte nil))) - (or multibyte - (setq coding - (coding-system-change-text-conversion - coding 'raw-text))) - (decode-coding-region 1 (point-max) coding) - (set-buffer-file-coding-system coding)) + (abbreviate-file-name buffer-file-name))) + (decode-coding-region start end coding buffer) + (save-excursion + (set-buffer buffer) + (goto-char (point-min)) ;; Set the default-directory to the dir of the ;; superior buffer. (setq default-directory @@ -753,7 +734,7 @@ appear on disk when you save the tar-file's buffer." (tar-subfile-mode 1)) (set-buffer tar-buffer)) (narrow-to-region 1 tar-header-offset) - (set-buffer-multibyte tar-buffer-multibyte))) + (goto-char pos))) (if view-p (view-buffer buffer (and just-created 'kill-buffer)) (if (eq other-window-p 'display) @@ -810,7 +791,6 @@ the current tar-entry." (size (tar-header-size tokens)) (start (+ (tar-desc-data-start descriptor) tar-header-offset -1)) (end (+ start size)) - (multibyte enable-multibyte-characters) (inhibit-file-name-handlers inhibit-file-name-handlers) (inhibit-file-name-operation inhibit-file-name-operation)) (save-restriction @@ -824,11 +804,8 @@ the current tar-entry." (and (eq inhibit-file-name-operation 'write-region) inhibit-file-name-handlers)) inhibit-file-name-operation 'write-region)) - (unwind-protect - (let ((coding-system-for-write 'no-conversion)) - (set-buffer-multibyte nil) - (write-region start end to-file nil nil nil t)) - (set-buffer-multibyte multibyte))) + (let ((coding-system-for-write 'no-conversion)) + (write-region start end to-file nil nil nil t))) (message "Copied tar entry %s to %s" name to-file))) (defun tar-flag-deleted (p &optional unflag) @@ -857,7 +834,6 @@ With a prefix argument, un-mark that many files backward." (tar-flag-deleted (- p) t)) -;; When this function is called, it is sure that the buffer is unibyte. (defun tar-expunge-internal () "Expunge the tar-entry specified by the current line." (let* ((descriptor (tar-current-descriptor)) @@ -909,9 +885,7 @@ for this to be permanent." (interactive) (if (or noconfirm (y-or-n-p "Expunge files marked for deletion? ")) - (let ((n 0) - (multibyte enable-multibyte-characters)) - (set-buffer-multibyte nil) + (let ((n 0)) (save-excursion (goto-char (point-min)) (while (not (eobp)) @@ -922,7 +896,6 @@ for this to be permanent." ;; after doing the deletions, add any padding that may be necessary. (tar-pad-to-blocksize) (narrow-to-region 1 tar-header-offset)) - (set-buffer-multibyte multibyte) (if (zerop n) (message "Nothing to expunge.") (message "%s files expunged. Be sure to save this buffer." n))))) @@ -933,7 +906,7 @@ for this to be permanent." (interactive) (save-excursion (goto-char (point-min)) - (while (< (position-bytes (point)) tar-header-offset) + (while (< (point) tar-header-offset) (if (not (eq (following-char) ?\ )) (progn (delete-char 1) (insert " "))) (forward-line 1)))) @@ -1003,11 +976,13 @@ for this to be permanent." (list (read-string "New name: " (tar-header-name (tar-desc-tokens (tar-current-descriptor)))))) (if (string= "" new-name) (error "zero length name")) - (if (> (length new-name) 98) (error "name too long")) - (tar-setf (tar-header-name (tar-desc-tokens (tar-current-descriptor))) - new-name) - (tar-alter-one-field 0 - (substring (concat new-name (make-string 99 0)) 0 99))) + (let ((encoded-new-name (encode-coding-string new-name + tar-file-name-coding-system))) + (if (> (length encoded-new-name) 98) (error "name too long")) + (tar-setf (tar-header-name (tar-desc-tokens (tar-current-descriptor))) + new-name) + (tar-alter-one-field 0 + (substring (concat encoded-new-name (make-string 99 0)) 0 99)))) (defun tar-chmod-entry (new-mode) @@ -1024,8 +999,7 @@ for this to be permanent." (defun tar-alter-one-field (data-position new-data-string) (let* ((descriptor (tar-current-descriptor)) - (tokens (tar-desc-tokens descriptor)) - (multibyte enable-multibyte-characters)) + (tokens (tar-desc-tokens descriptor))) (unwind-protect (save-excursion ;; @@ -1035,16 +1009,21 @@ for this to be permanent." (forward-line 1) (delete-region p (point)) (insert (tar-header-block-summarize tokens) "\n") - (setq tar-header-offset (position-bytes (point-max)))) + (setq tar-header-offset (point-max))) (widen) - (set-buffer-multibyte nil) (let* ((start (+ (tar-desc-data-start descriptor) tar-header-offset -513))) ;; ;; delete the old field and insert a new one. (goto-char (+ start data-position)) (delete-region (point) (+ (point) (length new-data-string))) ; <-- - (insert new-data-string) ; <-- + + ;; As new-data-string is unibyte, just inserting it will + ;; make eight-bit chars to the corresponding multibyte + ;; chars. This avoid that conversion, i.e., eight-bit + ;; chars are converted to multibyte form of eight-bit + ;; chars. + (insert (string-to-multibyte new-data-string)) ;; ;; compute a new checksum and insert it. (let ((chk (tar-header-block-checksum @@ -1062,7 +1041,6 @@ for this to be permanent." chk (tar-header-name tokens)) ))) (narrow-to-region 1 tar-header-offset) - (set-buffer-multibyte multibyte) (tar-next-line 0)))) @@ -1086,14 +1064,9 @@ to make your changes permanent." (error "This buffer doesn't have an index into its superior tar file!")) (save-excursion (let ((subfile (current-buffer)) - (subfile-multibyte enable-multibyte-characters) (coding buffer-file-coding-system) (descriptor tar-superior-descriptor) subfile-size) - ;; We must make the current buffer unibyte temporarily to avoid - ;; multibyte->unibyte conversion in `insert-buffer'. - (set-buffer-multibyte nil) - (setq subfile-size (buffer-size)) (set-buffer tar-superior-buffer) (let* ((tokens (tar-desc-tokens descriptor)) (start (tar-desc-data-start descriptor)) @@ -1101,28 +1074,28 @@ to make your changes permanent." (size (tar-header-size tokens)) (size-pad (ash (ash (+ size 511) -9) 9)) (head (memq descriptor tar-parse-info)) - (following-descs (cdr head)) - (tar-buffer-multibyte enable-multibyte-characters)) + (following-descs (cdr head))) (if (not head) (error "Can't find this tar file entry in its parent tar file!")) (unwind-protect (save-excursion - (widen) - (set-buffer-multibyte nil) ;; delete the old data... (let* ((data-start (+ start tar-header-offset -1)) (data-end (+ data-start (ash (ash (+ size 511) -9) 9)))) - (delete-region data-start data-end) + (narrow-to-region data-start data-end) + (delete-region (point-min) (point-max)) ;; insert the new data... (goto-char data-start) - (insert-buffer subfile) - (setq subfile-size - (encode-coding-region - data-start (+ data-start subfile-size) coding)) + (save-excursion + (set-buffer subfile) + (save-restriction + (widen) + (encode-coding-region 1 (point-max) coding tar-superior-buffer))) + (setq subfile-size (- (point-max) (point-min))) ;; ;; pad the new data out to a multiple of 512... (let ((subfile-size-pad (ash (ash (+ subfile-size 511) -9) 9))) - (goto-char (+ data-start subfile-size)) + (goto-char (point-max)) (insert (make-string (- subfile-size-pad subfile-size) 0)) ;; ;; update the data pointer of this and all following files... @@ -1133,6 +1106,7 @@ to make your changes permanent." (+ (tar-desc-data-start desc) difference)))) ;; ;; Update the size field in the header block. + (widen) (let ((header-start (- data-start 512))) (goto-char (+ header-start tar-size-offset)) (delete-region (point) (+ (point) 12)) @@ -1171,21 +1145,16 @@ to make your changes permanent." ;; Insert the new text after the old, before deleting, ;; to preserve the window start. (let ((line (tar-header-block-summarize tokens t))) - (if (multibyte-string-p line) - (insert-before-markers (string-as-unibyte line) "\n") - (insert-before-markers line "\n"))) + (insert-before-markers line "\n")) (delete-region p after) (setq tar-header-offset (marker-position m))) ))) ;; after doing the insertion, add any final padding that may be necessary. (tar-pad-to-blocksize)) - (narrow-to-region 1 tar-header-offset) - (set-buffer-multibyte tar-buffer-multibyte))) + (narrow-to-region 1 tar-header-offset))) (set-buffer-modified-p t) ; mark the tar file as modified (tar-next-line 0) (set-buffer subfile) - ;; Restore the buffer multibyteness. - (set-buffer-multibyte subfile-multibyte) (set-buffer-modified-p nil) ; mark the tar subfile as unmodified (message "Saved into tar-buffer `%s'. Be sure to save that buffer!" (buffer-name tar-superior-buffer)) @@ -1235,14 +1204,13 @@ Leaves the region wide." ;; tar-header-offset turns out to be null for files fetched with W3, ;; at least. (let ((coding-system-for-write 'no-conversion)) - (write-region (if tar-header-offset - (byte-to-position tar-header-offset) - (point-min)) + (write-region (or tar-header-offset + (point-min)) (point-max) buffer-file-name nil t)) (tar-clear-modification-flags) (set-buffer-modified-p nil)) - (narrow-to-region 1 (byte-to-position tar-header-offset))) + (narrow-to-region 1 tar-header-offset)) ;; Return t because we've written the file. t)