mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-26 10:49:33 +00:00
Code Issues Releases Activity

(tar-file-name-coding-system): New variable. Make

Browse Source 
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.
This commit is contained in:
Kenichi Handa 2002-07-31 07:14:35 +00:00
parent ad38511a70
commit d26e6665bf
1 changed files with 75 additions and 107 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

182
lisp/tar-mode.el
View File

@ -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)