X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/e66f4dfb7555eed2da7b2632f9dd87a793226127..659114fdba7d5ea14541cdc713c7f9745eb93c46:/lisp/tar-mode.el diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el index e0c78c8b78..fdac245c53 100644 --- a/lisp/tar-mode.el +++ b/lisp/tar-mode.el @@ -1,7 +1,6 @@ ;;; tar-mode.el --- simple editing of tar files from GNU emacs -;; Copyright (C) 1990, 1991, 1993, 1994, 1995, 1996, 1997, 1998, 1999, -;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1990-1991, 1993-2011 Free Software Foundation, Inc. ;; Author: Jamie Zawinski ;; Maintainer: FSF @@ -136,7 +135,6 @@ This information is useful, but it takes screen space away from file names." (defvar tar-parse-info 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-superior-buffer 'permanent-local t) @@ -170,8 +168,9 @@ This information is useful, but it takes screen space away from file names." ;; state correctly: the raw data is expected to be always larger than ;; the summary. (progn - (assert (eq tar-data-swapped - (> (buffer-size tar-data-buffer) (buffer-size)))) + (assert (or (= (buffer-size tar-data-buffer) (buffer-size)) + (eq tar-data-swapped + (> (buffer-size tar-data-buffer) (buffer-size))))) tar-data-swapped))) (defun tar-swap-data () @@ -267,7 +266,7 @@ write-date, checksum, link-type, and link-name." (setq name (concat (substring string tar-prefix-offset (1- (match-end 0))) "/" name))) - (if default-enable-multibyte-characters + (if (default-value 'enable-multibyte-characters) (setq name (decode-coding-string name coding) linkname @@ -284,7 +283,8 @@ write-date, checksum, link-type, and link-name." (let* ((size (tar-parse-octal-integer string tar-size-offset tar-time-offset)) ;; -1 so as to strip the terminating 0 byte. - (name (buffer-substring pos (+ pos size -1))) + (name (decode-coding-string + (buffer-substring pos (+ pos size -1)) coding)) (descriptor (tar-header-block-tokenize (+ pos (tar-roundup-512 size)) coding))) @@ -311,8 +311,12 @@ write-date, checksum, link-type, and link-name." link-p linkname uname-valid-p - (and uname-valid-p (substring string tar-uname-offset uname-end)) - (and uname-valid-p (substring string tar-gname-offset gname-end)) + (when uname-valid-p + (decode-coding-string + (substring string tar-uname-offset uname-end) coding)) + (when uname-valid-p + (decode-coding-string + (substring string tar-gname-offset gname-end) coding)) (tar-parse-octal-integer string tar-dmaj-offset tar-dmin-offset) (tar-parse-octal-integer string tar-dmin-offset tar-prefix-offset) )))))) @@ -666,29 +670,21 @@ See also: variables `tar-update-datestamp' and `tar-anal-blocksize'. (signal (car err) (cdr err))))) -(defun tar-subfile-mode (p) +(define-minor-mode tar-subfile-mode "Minor mode for editing an element of a tar-file. 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." - (interactive "P") + ;; 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")) - ;; Don't do this, because it is redundant and wastes mode line space. - ;; (or (assq 'tar-subfile-mode minor-mode-alist) - ;; (setq minor-mode-alist (append minor-mode-alist - ;; (list '(tar-subfile-mode " TarFile"))))) - (make-local-variable 'tar-subfile-mode) - (setq tar-subfile-mode - (if (null p) - (not tar-subfile-mode) - (> (prefix-numeric-value p) 0))) (cond (tar-subfile-mode (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) - (run-hooks 'tar-subfile-mode-hook)) + (setq buffer-auto-save-file-name nil)) (t (remove-hook 'write-file-functions 'tar-subfile-save-buffer t)))) @@ -819,7 +815,7 @@ appear on disk when you save the 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-enable-multibyte-characters + (if (and (default-value 'enable-multibyte-characters) (coding-system-get coding :for-unibyte)) (with-current-buffer buffer (set-buffer-multibyte nil))) @@ -846,14 +842,12 @@ appear on disk when you save the tar-file's buffer." (set (make-local-variable 'tar-superior-descriptor) descriptor) (setq buffer-read-only read-only-p) (tar-subfile-mode 1))) - (if view-p - (view-buffer - buffer (and just-created 'kill-buffer-if-not-modified)) - (if (eq other-window-p 'display) - (display-buffer buffer) - (if other-window-p - (switch-to-buffer-other-window buffer) - (switch-to-buffer 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)))))) (defun tar-extract-other-window () @@ -903,12 +897,14 @@ the current tar-entry." (end (+ start size)) (inhibit-file-name-handlers inhibit-file-name-handlers) (inhibit-file-name-operation inhibit-file-name-operation)) - (save-restriction - (widen) + (with-current-buffer + (if (tar-data-swapped-p) tar-data-buffer (current-buffer)) ;; Inhibit compressing a subfile again if *both* name and ;; to-file are handled by jka-compr - (if (and (eq (find-file-name-handler name 'write-region) 'jka-compr-handler) - (eq (find-file-name-handler to-file 'write-region) 'jka-compr-handler)) + (if (and (eq (find-file-name-handler name 'write-region) + 'jka-compr-handler) + (eq (find-file-name-handler to-file 'write-region) + 'jka-compr-handler)) (setq inhibit-file-name-handlers (cons 'jka-compr-handler (and (eq inhibit-file-name-operation 'write-region) @@ -1012,7 +1008,10 @@ for this to be permanent." (read-string "New UID string: " (tar-header-uname descriptor)))))) (cond ((stringp new-uid) (setf (tar-header-uname (tar-current-descriptor)) new-uid) - (tar-alter-one-field tar-uname-offset (concat new-uid "\000"))) + (tar-alter-one-field tar-uname-offset + (concat (encode-coding-string + new-uid tar-file-name-coding-system) + "\000"))) (t (setf (tar-header-uid (tar-current-descriptor)) new-uid) (tar-alter-one-field tar-uid-offset @@ -1038,7 +1037,9 @@ for this to be permanent." (cond ((stringp new-gid) (setf (tar-header-gname (tar-current-descriptor)) new-gid) (tar-alter-one-field tar-gname-offset - (concat new-gid "\000"))) + (concat (encode-coding-string + new-gid tar-file-name-coding-system) + "\000"))) (t (setf (tar-header-gid (tar-current-descriptor)) new-gid) (tar-alter-one-field tar-gid-offset @@ -1244,5 +1245,4 @@ Leaves the region wide." (provide 'tar-mode) -;; arch-tag: 8a585a4a-340e-42c2-89e7-d3b1013a4b78 ;;; tar-mode.el ends here