Mercurial > emacs
annotate lisp/tar-mode.el @ 24419:30e478cd167e
(shell-command-default-error-buffer): Renamed from
shell-command-on-region-default-error-buffer.
(shell-command-on-region): Mention in echo area when there
is some error output. Mention success or failure, too.
Accumulate multiple error outputs
going forward, with formfeed in between. Display the error buffer
when we have put something in it.
(shell-command): Add the ERROR-BUFFER argument feature.
author | Karl Heuer <kwzh@gnu.org> |
---|---|
date | Mon, 01 Mar 1999 03:19:32 +0000 |
parents | d30ffa793626 |
children | 2033936f1aa7 |
rev | line source |
---|---|
658
7cbd4fcd8b0f
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
584
diff
changeset
|
1 ;;; tar-mode.el --- simple editing of tar files from GNU emacs |
212 | 2 |
14169 | 3 ;; Copyright (C) 1990, 1991, 1993, 1994, 1995 Free Software Foundation, Inc. |
840
113281b361ec
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
814
diff
changeset
|
4 |
775
1ca26ccad38e
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
658
diff
changeset
|
5 ;; Author: Jamie Zawinski <jwz@lucid.com> |
21045 | 6 ;; Maintainer: FSF |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
775
diff
changeset
|
7 ;; Created: 04 Apr 1990 |
814
38b2499cb3e9
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
807
diff
changeset
|
8 ;; Keywords: unix |
212 | 9 |
14169 | 10 ;; This file is part of GNU Emacs. |
11 | |
12 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
13 ;; it under the terms of the GNU General Public License as published by | |
14 ;; the Free Software Foundation; either version 2, or (at your option) | |
15 ;; any later version. | |
16 | |
17 ;; GNU Emacs is distributed in the hope that it will be useful, | |
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 ;; GNU General Public License for more details. | |
21 | |
22 ;; You should have received a copy of the GNU General Public License | |
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
25 ;; Boston, MA 02111-1307, USA. | |
212 | 26 |
775
1ca26ccad38e
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
658
diff
changeset
|
27 ;;; Commentary: |
1ca26ccad38e
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
658
diff
changeset
|
28 |
14169 | 29 ;; This package attempts to make dealing with Unix 'tar' archives easier. |
30 ;; When this code is loaded, visiting a file whose name ends in '.tar' will | |
31 ;; cause the contents of that archive file to be displayed in a Dired-like | |
32 ;; listing. It is then possible to use the customary Dired keybindings to | |
33 ;; extract sub-files from that archive, either by reading them into their own | |
34 ;; editor buffers, or by copying them directly to arbitrary files on disk. | |
35 ;; It is also possible to delete sub-files from within the tar file and write | |
36 ;; the modified archive back to disk, or to edit sub-files within the archive | |
37 ;; and re-insert the modified files into the archive. See the documentation | |
38 ;; string of tar-mode for more info. | |
212 | 39 |
14169 | 40 ;; This code now understands the extra fields that GNU tar adds to tar files. |
212 | 41 |
14169 | 42 ;; This interacts correctly with "uncompress.el" in the Emacs library, |
43 ;; which you get with | |
44 ;; | |
45 ;; (autoload 'uncompress-while-visiting "uncompress") | |
46 ;; (setq auto-mode-alist (cons '("\\.Z$" . uncompress-while-visiting) | |
47 ;; auto-mode-alist)) | |
48 ;; | |
49 ;; Do not attempt to use tar-mode.el with crypt.el, you will lose. | |
212 | 50 |
14169 | 51 ;; *************** TO DO *************** |
52 ;; | |
53 ;; o chmod should understand "a+x,og-w". | |
54 ;; | |
55 ;; o It's not possible to add a NEW file to a tar archive; not that | |
56 ;; important, but still... | |
57 ;; | |
58 ;; o The code is less efficient that it could be - in a lot of places, I | |
59 ;; pull a 512-character string out of the buffer and parse it, when I could | |
60 ;; be parsing it in place, not garbaging a string. Should redo that. | |
61 ;; | |
62 ;; o I'd like a command that searches for a string/regexp in every subfile | |
63 ;; of an archive, where <esc> would leave you in a subfile-edit buffer. | |
64 ;; (Like the Meta-R command of the Zmacs mail reader.) | |
65 ;; | |
66 ;; o Sometimes (but not always) reverting the tar-file buffer does not | |
67 ;; re-grind the listing, and you are staring at the binary tar data. | |
68 ;; Typing 'g' again immediately after that will always revert and re-grind | |
69 ;; it, though. I have no idea why this happens. | |
70 ;; | |
71 ;; o Tar-mode interacts poorly with crypt.el and zcat.el because the tar | |
72 ;; write-file-hook actually writes the file. Instead it should remove the | |
73 ;; header (and conspire to put it back afterwards) so that other write-file | |
74 ;; hooks which frob the buffer have a chance to do their dirty work. There | |
75 ;; might be a problem if the tar write-file-hook does not come *first* on | |
76 ;; the list. | |
77 ;; | |
78 ;; o Block files, sparse files, continuation files, and the various header | |
79 ;; types aren't editable. Actually I don't know that they work at all. | |
212 | 80 |
14169 | 81 ;; Rationale: |
7103 | 82 |
14169 | 83 ;; Why does tar-mode edit the file itself instead of using tar? |
7103 | 84 |
14169 | 85 ;; That means that you can edit tar files which you don't have room for |
86 ;; on your local disk. | |
7103 | 87 |
14169 | 88 ;; I don't know about recent features in gnu tar, but old versions of tar |
89 ;; can't replace a file in the middle of a tar file with a new version. | |
90 ;; Tar-mode can. I don't think tar can do things like chmod the subfiles. | |
91 ;; An implementation which involved unpacking and repacking the file into | |
92 ;; some scratch directory would be very wasteful, and wouldn't be able to | |
93 ;; preserve the file owners. | |
7103 | 94 |
775
1ca26ccad38e
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
658
diff
changeset
|
95 ;;; Code: |
1ca26ccad38e
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
658
diff
changeset
|
96 |
20808 | 97 (defgroup tar nil |
98 "Simple editing of tar files." | |
99 :prefix "tar-" | |
100 :group 'data) | |
101 | |
102 (defcustom tar-anal-blocksize 20 | |
212 | 103 "*The blocksize of tar files written by Emacs, or nil, meaning don't care. |
104 The blocksize of a tar file is not really the size of the blocks; rather, it is | |
105 the number of blocks written with one system call. When tarring to a tape, | |
106 this is the size of the *tape* blocks, but when writing to a file, it doesn't | |
107 matter much. The only noticeable difference is that if a tar file does not | |
108 have a blocksize of 20, tar will tell you that; all this really controls is | |
20808 | 109 how many null padding bytes go on the end of the tar file." |
110 :type '(choice integer (const nil)) | |
111 :group 'tar) | |
212 | 112 |
20808 | 113 (defcustom tar-update-datestamp nil |
22473
74e7682de297
(tar-mode): Locally bind local-enable-local-variables,
Richard M. Stallman <rms@gnu.org>
parents:
22305
diff
changeset
|
114 "*Non-nil means Tar mode should play fast and loose with sub-file datestamps. |
10843
2f2e5033b3bb
(tar-header-block-tokenize): Parse 32-bit modtime
Richard M. Stallman <rms@gnu.org>
parents:
10271
diff
changeset
|
115 If this is true, then editing and saving a tar file entry back into its |
212 | 116 tar file will update its datestamp. If false, the datestamp is unchanged. |
117 You may or may not want this - it is good in that you can tell when a file | |
118 in a tar archive has been changed, but it is bad for the same reason that | |
119 editing a file in the tar archive at all is bad - the changed version of | |
20808 | 120 the file never exists on disk." |
121 :type 'boolean | |
122 :group 'tar) | |
212 | 123 |
20808 | 124 (defcustom tar-mode-show-date nil |
10843
2f2e5033b3bb
(tar-header-block-tokenize): Parse 32-bit modtime
Richard M. Stallman <rms@gnu.org>
parents:
10271
diff
changeset
|
125 "*Non-nil means Tar mode should show the date/time of each subfile. |
20808 | 126 This information is useful, but it takes screen space away from file names." |
127 :type 'boolean | |
128 :group 'tar) | |
10843
2f2e5033b3bb
(tar-header-block-tokenize): Parse 32-bit modtime
Richard M. Stallman <rms@gnu.org>
parents:
10271
diff
changeset
|
129 |
2542
ae4176e2e8fa
Add defvars to pacify the byte compiler, at RMS's request.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
880
diff
changeset
|
130 (defvar tar-parse-info nil) |
23716
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
131 ;; Be sure that this variable holds byte position, not char position. |
2542
ae4176e2e8fa
Add defvars to pacify the byte compiler, at RMS's request.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
880
diff
changeset
|
132 (defvar tar-header-offset nil) |
ae4176e2e8fa
Add defvars to pacify the byte compiler, at RMS's request.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
880
diff
changeset
|
133 (defvar tar-superior-buffer nil) |
ae4176e2e8fa
Add defvars to pacify the byte compiler, at RMS's request.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
880
diff
changeset
|
134 (defvar tar-superior-descriptor nil) |
ae4176e2e8fa
Add defvars to pacify the byte compiler, at RMS's request.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
880
diff
changeset
|
135 (defvar tar-subfile-mode nil) |
4260
e0713a13f2d7
(tar-parse-info, tar-header-offset, tar-superior-buffer)
Richard M. Stallman <rms@gnu.org>
parents:
4120
diff
changeset
|
136 |
e0713a13f2d7
(tar-parse-info, tar-header-offset, tar-superior-buffer)
Richard M. Stallman <rms@gnu.org>
parents:
4120
diff
changeset
|
137 (put 'tar-parse-info 'permanent-local t) |
e0713a13f2d7
(tar-parse-info, tar-header-offset, tar-superior-buffer)
Richard M. Stallman <rms@gnu.org>
parents:
4120
diff
changeset
|
138 (put 'tar-header-offset 'permanent-local t) |
e0713a13f2d7
(tar-parse-info, tar-header-offset, tar-superior-buffer)
Richard M. Stallman <rms@gnu.org>
parents:
4120
diff
changeset
|
139 (put 'tar-superior-buffer 'permanent-local t) |
e0713a13f2d7
(tar-parse-info, tar-header-offset, tar-superior-buffer)
Richard M. Stallman <rms@gnu.org>
parents:
4120
diff
changeset
|
140 (put 'tar-superior-descriptor 'permanent-local t) |
212 | 141 |
142 ;;; First, duplicate some Common Lisp functions; I used to just (require 'cl) | |
143 ;;; but "cl.el" was messing some people up (also it's really big). | |
144 | |
145 (defmacro tar-setf (form val) | |
146 "A mind-numbingly simple implementation of setf." | |
147 (let ((mform (macroexpand form (and (boundp 'byte-compile-macro-environment) | |
148 byte-compile-macro-environment)))) | |
149 (cond ((symbolp mform) (list 'setq mform val)) | |
150 ((not (consp mform)) (error "can't setf %s" form)) | |
151 ((eq (car mform) 'aref) | |
152 (list 'aset (nth 1 mform) (nth 2 mform) val)) | |
153 ((eq (car mform) 'car) | |
154 (list 'setcar (nth 1 mform) val)) | |
155 ((eq (car mform) 'cdr) | |
156 (list 'setcdr (nth 1 mform) val)) | |
157 (t (error "don't know how to setf %s" form))))) | |
158 | |
159 (defmacro tar-dolist (control &rest body) | |
160 "syntax: (dolist (var-name list-expr &optional return-value) &body body)" | |
161 (let ((var (car control)) | |
162 (init (car (cdr control))) | |
163 (val (car (cdr (cdr control))))) | |
164 (list 'let (list (list '_dolist_iterator_ init)) | |
165 (list 'while '_dolist_iterator_ | |
166 (cons 'let | |
167 (cons (list (list var '(car _dolist_iterator_))) | |
168 (append body | |
169 (list (list 'setq '_dolist_iterator_ | |
170 (list 'cdr '_dolist_iterator_))))))) | |
171 val))) | |
172 | |
173 (defmacro tar-dotimes (control &rest body) | |
174 "syntax: (dolist (var-name count-expr &optional return-value) &body body)" | |
175 (let ((var (car control)) | |
176 (n (car (cdr control))) | |
177 (val (car (cdr (cdr control))))) | |
178 (list 'let (list (list '_dotimes_end_ n) | |
179 (list var 0)) | |
180 (cons 'while | |
181 (cons (list '< var '_dotimes_end_) | |
182 (append body | |
183 (list (list 'setq var (list '1+ var)))))) | |
184 val))) | |
185 | |
186 | |
187 ;;; down to business. | |
188 | |
189 (defmacro make-tar-header (name mode uid git size date ck lt ln | |
190 magic uname gname devmaj devmin) | |
191 (list 'vector name mode uid git size date ck lt ln | |
192 magic uname gname devmaj devmin)) | |
193 | |
194 (defmacro tar-header-name (x) (list 'aref x 0)) | |
195 (defmacro tar-header-mode (x) (list 'aref x 1)) | |
196 (defmacro tar-header-uid (x) (list 'aref x 2)) | |
197 (defmacro tar-header-gid (x) (list 'aref x 3)) | |
198 (defmacro tar-header-size (x) (list 'aref x 4)) | |
199 (defmacro tar-header-date (x) (list 'aref x 5)) | |
200 (defmacro tar-header-checksum (x) (list 'aref x 6)) | |
201 (defmacro tar-header-link-type (x) (list 'aref x 7)) | |
202 (defmacro tar-header-link-name (x) (list 'aref x 8)) | |
203 (defmacro tar-header-magic (x) (list 'aref x 9)) | |
204 (defmacro tar-header-uname (x) (list 'aref x 10)) | |
205 (defmacro tar-header-gname (x) (list 'aref x 11)) | |
206 (defmacro tar-header-dmaj (x) (list 'aref x 12)) | |
207 (defmacro tar-header-dmin (x) (list 'aref x 13)) | |
208 | |
209 (defmacro make-tar-desc (data-start tokens) | |
210 (list 'cons data-start tokens)) | |
211 | |
212 (defmacro tar-desc-data-start (x) (list 'car x)) | |
213 (defmacro tar-desc-tokens (x) (list 'cdr x)) | |
214 | |
215 (defconst tar-name-offset 0) | |
216 (defconst tar-mode-offset (+ tar-name-offset 100)) | |
217 (defconst tar-uid-offset (+ tar-mode-offset 8)) | |
218 (defconst tar-gid-offset (+ tar-uid-offset 8)) | |
219 (defconst tar-size-offset (+ tar-gid-offset 8)) | |
220 (defconst tar-time-offset (+ tar-size-offset 12)) | |
221 (defconst tar-chk-offset (+ tar-time-offset 12)) | |
222 (defconst tar-linkp-offset (+ tar-chk-offset 8)) | |
223 (defconst tar-link-offset (+ tar-linkp-offset 1)) | |
224 ;;; GNU-tar specific slots. | |
225 (defconst tar-magic-offset (+ tar-link-offset 100)) | |
226 (defconst tar-uname-offset (+ tar-magic-offset 8)) | |
227 (defconst tar-gname-offset (+ tar-uname-offset 32)) | |
228 (defconst tar-dmaj-offset (+ tar-gname-offset 32)) | |
229 (defconst tar-dmin-offset (+ tar-dmaj-offset 8)) | |
230 (defconst tar-end-offset (+ tar-dmin-offset 8)) | |
231 | |
8023
f29df49c6e53
(tar-extract): Set file name by hand before calling
Richard M. Stallman <rms@gnu.org>
parents:
7497
diff
changeset
|
232 (defun tar-header-block-tokenize (string) |
4387
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
233 "Return a `tar-header' structure. |
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
234 This is a list of name, mode, uid, gid, size, |
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
235 write-date, checksum, link-type, and link-name." |
212 | 236 (cond ((< (length string) 512) nil) |
237 (;(some 'plusp string) ; <-- oops, massive cycle hog! | |
238 (or (not (= 0 (aref string 0))) ; This will do. | |
239 (not (= 0 (aref string 101)))) | |
240 (let* ((name-end (1- tar-mode-offset)) | |
241 (link-end (1- tar-magic-offset)) | |
242 (uname-end (1- tar-gname-offset)) | |
243 (gname-end (1- tar-dmaj-offset)) | |
244 (link-p (aref string tar-linkp-offset)) | |
245 (magic-str (substring string tar-magic-offset (1- tar-uname-offset))) | |
246 (uname-valid-p (or (string= "ustar " magic-str) (string= "GNUtar " magic-str))) | |
247 name | |
248 (nulsexp "[^\000]*\000")) | |
249 (and (string-match nulsexp string tar-name-offset) (setq name-end (min name-end (1- (match-end 0))))) | |
250 (and (string-match nulsexp string tar-link-offset) (setq link-end (min link-end (1- (match-end 0))))) | |
251 (and (string-match nulsexp string tar-uname-offset) (setq uname-end (min uname-end (1- (match-end 0))))) | |
252 (and (string-match nulsexp string tar-gname-offset) (setq gname-end (min gname-end (1- (match-end 0))))) | |
253 (setq name (substring string tar-name-offset name-end) | |
254 link-p (if (or (= link-p 0) (= link-p ?0)) | |
255 nil | |
256 (- link-p ?0))) | |
23716
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
257 (setq linkname (substring string tar-link-offset link-end)) |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
258 (if default-enable-multibyte-characters |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
259 (setq name |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
260 (decode-coding-string name (or file-name-coding-system |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
261 'undecided)) |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
262 linkname |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
263 (decode-coding-string linkname (or file-name-coding-system |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
264 'undecided)))) |
212 | 265 (if (and (null link-p) (string-match "/$" name)) (setq link-p 5)) ; directory |
266 (make-tar-header | |
267 name | |
268 (tar-parse-octal-integer string tar-mode-offset (1- tar-uid-offset)) | |
269 (tar-parse-octal-integer string tar-uid-offset (1- tar-gid-offset)) | |
270 (tar-parse-octal-integer string tar-gid-offset (1- tar-size-offset)) | |
271 (tar-parse-octal-integer string tar-size-offset (1- tar-time-offset)) | |
10843
2f2e5033b3bb
(tar-header-block-tokenize): Parse 32-bit modtime
Richard M. Stallman <rms@gnu.org>
parents:
10271
diff
changeset
|
272 (tar-parse-octal-long-integer string tar-time-offset (1- tar-chk-offset)) |
212 | 273 (tar-parse-octal-integer string tar-chk-offset (1- tar-linkp-offset)) |
274 link-p | |
23716
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
275 linkname |
212 | 276 uname-valid-p |
277 (and uname-valid-p (substring string tar-uname-offset uname-end)) | |
278 (and uname-valid-p (substring string tar-gname-offset gname-end)) | |
279 (tar-parse-octal-integer string tar-dmaj-offset (1- tar-dmin-offset)) | |
280 (tar-parse-octal-integer string tar-dmin-offset (1- tar-end-offset)) | |
281 ))) | |
282 (t 'empty-tar-block))) | |
283 | |
284 | |
285 (defun tar-parse-octal-integer (string &optional start end) | |
286 (if (null start) (setq start 0)) | |
287 (if (null end) (setq end (length string))) | |
288 (if (= (aref string start) 0) | |
289 0 | |
290 (let ((n 0)) | |
291 (while (< start end) | |
292 (setq n (if (< (aref string start) ?0) n | |
10843
2f2e5033b3bb
(tar-header-block-tokenize): Parse 32-bit modtime
Richard M. Stallman <rms@gnu.org>
parents:
10271
diff
changeset
|
293 (+ (* n 8) (- (aref string start) ?0))) |
212 | 294 start (1+ start))) |
295 n))) | |
296 | |
10843
2f2e5033b3bb
(tar-header-block-tokenize): Parse 32-bit modtime
Richard M. Stallman <rms@gnu.org>
parents:
10271
diff
changeset
|
297 (defun tar-parse-octal-long-integer (string &optional start end) |
2f2e5033b3bb
(tar-header-block-tokenize): Parse 32-bit modtime
Richard M. Stallman <rms@gnu.org>
parents:
10271
diff
changeset
|
298 (if (null start) (setq start 0)) |
2f2e5033b3bb
(tar-header-block-tokenize): Parse 32-bit modtime
Richard M. Stallman <rms@gnu.org>
parents:
10271
diff
changeset
|
299 (if (null end) (setq end (length string))) |
2f2e5033b3bb
(tar-header-block-tokenize): Parse 32-bit modtime
Richard M. Stallman <rms@gnu.org>
parents:
10271
diff
changeset
|
300 (if (= (aref string start) 0) |
11071
d629a0af50ca
(tar-parse-octal-long-integer): Return list, not vector.
Karl Heuer <kwzh@gnu.org>
parents:
10922
diff
changeset
|
301 (list 0 0) |
10843
2f2e5033b3bb
(tar-header-block-tokenize): Parse 32-bit modtime
Richard M. Stallman <rms@gnu.org>
parents:
10271
diff
changeset
|
302 (let ((lo 0) |
2f2e5033b3bb
(tar-header-block-tokenize): Parse 32-bit modtime
Richard M. Stallman <rms@gnu.org>
parents:
10271
diff
changeset
|
303 (hi 0)) |
2f2e5033b3bb
(tar-header-block-tokenize): Parse 32-bit modtime
Richard M. Stallman <rms@gnu.org>
parents:
10271
diff
changeset
|
304 (while (< start end) |
2f2e5033b3bb
(tar-header-block-tokenize): Parse 32-bit modtime
Richard M. Stallman <rms@gnu.org>
parents:
10271
diff
changeset
|
305 (if (>= (aref string start) ?0) |
2f2e5033b3bb
(tar-header-block-tokenize): Parse 32-bit modtime
Richard M. Stallman <rms@gnu.org>
parents:
10271
diff
changeset
|
306 (setq lo (+ (* lo 8) (- (aref string start) ?0)) |
2f2e5033b3bb
(tar-header-block-tokenize): Parse 32-bit modtime
Richard M. Stallman <rms@gnu.org>
parents:
10271
diff
changeset
|
307 hi (+ (* hi 8) (ash lo -16)) |
2f2e5033b3bb
(tar-header-block-tokenize): Parse 32-bit modtime
Richard M. Stallman <rms@gnu.org>
parents:
10271
diff
changeset
|
308 lo (logand lo 65535))) |
2f2e5033b3bb
(tar-header-block-tokenize): Parse 32-bit modtime
Richard M. Stallman <rms@gnu.org>
parents:
10271
diff
changeset
|
309 (setq start (1+ start))) |
2f2e5033b3bb
(tar-header-block-tokenize): Parse 32-bit modtime
Richard M. Stallman <rms@gnu.org>
parents:
10271
diff
changeset
|
310 (list hi lo)))) |
2f2e5033b3bb
(tar-header-block-tokenize): Parse 32-bit modtime
Richard M. Stallman <rms@gnu.org>
parents:
10271
diff
changeset
|
311 |
212 | 312 (defun tar-parse-octal-integer-safe (string) |
313 (let ((L (length string))) | |
314 (if (= L 0) (error "empty string")) | |
315 (tar-dotimes (i L) | |
316 (if (or (< (aref string i) ?0) | |
317 (> (aref string i) ?7)) | |
22473
74e7682de297
(tar-mode): Locally bind local-enable-local-variables,
Richard M. Stallman <rms@gnu.org>
parents:
22305
diff
changeset
|
318 (error "`%c' is not an octal digit")))) |
212 | 319 (tar-parse-octal-integer string)) |
320 | |
321 | |
8023
f29df49c6e53
(tar-extract): Set file name by hand before calling
Richard M. Stallman <rms@gnu.org>
parents:
7497
diff
changeset
|
322 (defun tar-header-block-checksum (string) |
4387
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
323 "Compute and return a tar-acceptable checksum for this block." |
212 | 324 (let* ((chk-field-start tar-chk-offset) |
325 (chk-field-end (+ chk-field-start 8)) | |
326 (sum 0) | |
327 (i 0)) | |
328 ;; Add up all of the characters except the ones in the checksum field. | |
329 ;; Add that field as if it were filled with spaces. | |
330 (while (< i chk-field-start) | |
331 (setq sum (+ sum (aref string i)) | |
332 i (1+ i))) | |
333 (setq i chk-field-end) | |
334 (while (< i 512) | |
335 (setq sum (+ sum (aref string i)) | |
336 i (1+ i))) | |
337 (+ sum (* 32 8)))) | |
338 | |
8023
f29df49c6e53
(tar-extract): Set file name by hand before calling
Richard M. Stallman <rms@gnu.org>
parents:
7497
diff
changeset
|
339 (defun tar-header-block-check-checksum (hblock desired-checksum file-name) |
212 | 340 "Beep and print a warning if the checksum doesn't match." |
8023
f29df49c6e53
(tar-extract): Set file name by hand before calling
Richard M. Stallman <rms@gnu.org>
parents:
7497
diff
changeset
|
341 (if (not (= desired-checksum (tar-header-block-checksum hblock))) |
212 | 342 (progn (beep) (message "Invalid checksum for file %s!" file-name)))) |
343 | |
8023
f29df49c6e53
(tar-extract): Set file name by hand before calling
Richard M. Stallman <rms@gnu.org>
parents:
7497
diff
changeset
|
344 (defun tar-header-block-recompute-checksum (hblock) |
212 | 345 "Modifies the given string to have a valid checksum field." |
8023
f29df49c6e53
(tar-extract): Set file name by hand before calling
Richard M. Stallman <rms@gnu.org>
parents:
7497
diff
changeset
|
346 (let* ((chk (tar-header-block-checksum hblock)) |
212 | 347 (chk-string (format "%6o" chk)) |
348 (l (length chk-string))) | |
349 (aset hblock 154 0) | |
350 (aset hblock 155 32) | |
351 (tar-dotimes (i l) (aset hblock (- 153 i) (aref chk-string (- l i 1))))) | |
352 hblock) | |
353 | |
10843
2f2e5033b3bb
(tar-header-block-tokenize): Parse 32-bit modtime
Richard M. Stallman <rms@gnu.org>
parents:
10271
diff
changeset
|
354 (defun tar-clip-time-string (time) |
2f2e5033b3bb
(tar-header-block-tokenize): Parse 32-bit modtime
Richard M. Stallman <rms@gnu.org>
parents:
10271
diff
changeset
|
355 (let ((str (current-time-string time))) |
2f2e5033b3bb
(tar-header-block-tokenize): Parse 32-bit modtime
Richard M. Stallman <rms@gnu.org>
parents:
10271
diff
changeset
|
356 (concat (substring str 4 16) (substring str 19 24)))) |
212 | 357 |
358 (defun tar-grind-file-mode (mode string start) | |
10922
0c3d44805949
(tar-grind-file-mode): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
10843
diff
changeset
|
359 "Store `-rw--r--r--' indicating MODE into STRING beginning at START. |
0c3d44805949
(tar-grind-file-mode): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
10843
diff
changeset
|
360 MODE should be an integer which is a file mode value." |
212 | 361 (aset string start (if (zerop (logand 256 mode)) ?- ?r)) |
362 (aset string (+ start 1) (if (zerop (logand 128 mode)) ?- ?w)) | |
363 (aset string (+ start 2) (if (zerop (logand 64 mode)) ?- ?x)) | |
364 (aset string (+ start 3) (if (zerop (logand 32 mode)) ?- ?r)) | |
365 (aset string (+ start 4) (if (zerop (logand 16 mode)) ?- ?w)) | |
366 (aset string (+ start 5) (if (zerop (logand 8 mode)) ?- ?x)) | |
367 (aset string (+ start 6) (if (zerop (logand 4 mode)) ?- ?r)) | |
368 (aset string (+ start 7) (if (zerop (logand 2 mode)) ?- ?w)) | |
369 (aset string (+ start 8) (if (zerop (logand 1 mode)) ?- ?x)) | |
370 (if (zerop (logand 1024 mode)) nil (aset string (+ start 2) ?s)) | |
371 (if (zerop (logand 2048 mode)) nil (aset string (+ start 5) ?s)) | |
372 string) | |
373 | |
8023
f29df49c6e53
(tar-extract): Set file name by hand before calling
Richard M. Stallman <rms@gnu.org>
parents:
7497
diff
changeset
|
374 (defun tar-header-block-summarize (tar-hblock &optional mod-p) |
4387
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
375 "Returns a line similar to the output of `tar -vtf'." |
212 | 376 (let ((name (tar-header-name tar-hblock)) |
377 (mode (tar-header-mode tar-hblock)) | |
378 (uid (tar-header-uid tar-hblock)) | |
379 (gid (tar-header-gid tar-hblock)) | |
380 (uname (tar-header-uname tar-hblock)) | |
381 (gname (tar-header-gname tar-hblock)) | |
382 (size (tar-header-size tar-hblock)) | |
383 (time (tar-header-date tar-hblock)) | |
384 (ck (tar-header-checksum tar-hblock)) | |
385 (link-p (tar-header-link-type tar-hblock)) | |
386 (link-name (tar-header-link-name tar-hblock)) | |
387 ) | |
388 (let* ((left 11) | |
389 (namew 8) | |
390 (groupw 8) | |
391 (sizew 8) | |
10843
2f2e5033b3bb
(tar-header-block-tokenize): Parse 32-bit modtime
Richard M. Stallman <rms@gnu.org>
parents:
10271
diff
changeset
|
392 (datew (if tar-mode-show-date 18 0)) |
212 | 393 (slash (1- (+ left namew))) |
394 (lastdigit (+ slash groupw sizew)) | |
10843
2f2e5033b3bb
(tar-header-block-tokenize): Parse 32-bit modtime
Richard M. Stallman <rms@gnu.org>
parents:
10271
diff
changeset
|
395 (datestart (+ lastdigit 2)) |
2f2e5033b3bb
(tar-header-block-tokenize): Parse 32-bit modtime
Richard M. Stallman <rms@gnu.org>
parents:
10271
diff
changeset
|
396 (namestart (+ datestart datew)) |
23716
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
397 (multibyte (or (multibyte-string-p name) |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
398 (multibyte-string-p link-name))) |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
399 ;; If multibyte, we can't use optimized method of aset, |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
400 ;; instead we must use concat. |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
401 (string (make-string (if multibyte |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
402 namestart |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
403 (+ namestart |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
404 (length name) |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
405 (if link-p (+ 5 (length link-name)) 0))) |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
406 32)) |
212 | 407 (type (tar-header-link-type tar-hblock))) |
408 (aset string 0 (if mod-p ?* ? )) | |
409 (aset string 1 | |
410 (cond ((or (eq type nil) (eq type 0)) ?-) | |
411 ((eq type 1) ?l) ; link | |
412 ((eq type 2) ?s) ; symlink | |
413 ((eq type 3) ?c) ; char special | |
414 ((eq type 4) ?b) ; block special | |
415 ((eq type 5) ?d) ; directory | |
416 ((eq type 6) ?p) ; FIFO/pipe | |
417 ((eq type 20) ?*) ; directory listing | |
418 ((eq type 29) ?M) ; multivolume continuation | |
419 ((eq type 35) ?S) ; sparse | |
420 ((eq type 38) ?V) ; volume header | |
421 )) | |
422 (tar-grind-file-mode mode string 2) | |
423 (setq uid (if (= 0 (length uname)) (int-to-string uid) uname)) | |
424 (setq gid (if (= 0 (length gname)) (int-to-string gid) gname)) | |
425 (setq size (int-to-string size)) | |
10843
2f2e5033b3bb
(tar-header-block-tokenize): Parse 32-bit modtime
Richard M. Stallman <rms@gnu.org>
parents:
10271
diff
changeset
|
426 (setq time (tar-clip-time-string time)) |
212 | 427 (tar-dotimes (i (min (1- namew) (length uid))) (aset string (- slash i) (aref uid (- (length uid) i 1)))) |
428 (aset string (1+ slash) ?/) | |
429 (tar-dotimes (i (min (1- groupw) (length gid))) (aset string (+ (+ slash 2) i) (aref gid i))) | |
430 (tar-dotimes (i (min sizew (length size))) (aset string (- lastdigit i) (aref size (- (length size) i 1)))) | |
10843
2f2e5033b3bb
(tar-header-block-tokenize): Parse 32-bit modtime
Richard M. Stallman <rms@gnu.org>
parents:
10271
diff
changeset
|
431 (if tar-mode-show-date |
2f2e5033b3bb
(tar-header-block-tokenize): Parse 32-bit modtime
Richard M. Stallman <rms@gnu.org>
parents:
10271
diff
changeset
|
432 (tar-dotimes (i (length time)) (aset string (+ datestart i) (aref time i)))) |
23716
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
433 (if multibyte |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
434 (setq string (concat string name)) |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
435 (tar-dotimes (i (length name)) (aset string (+ namestart i) (aref name i)))) |
212 | 436 (if (or (eq link-p 1) (eq link-p 2)) |
23716
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
437 (if multibyte |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
438 (setq string (concat string |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
439 (if (= link-p 1) " ==> " " --> ") |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
440 link-name)) |
212 | 441 (tar-dotimes (i 3) (aset string (+ namestart 1 (length name) i) (aref (if (= link-p 1) "==>" "-->") i))) |
442 (tar-dotimes (i (length link-name)) (aset string (+ namestart 5 (length name) i) (aref link-name i))))) | |
6641
4e76332f7b44
(summarize-tar-header-block): Add mouse-face properties.
Karl Heuer <kwzh@gnu.org>
parents:
6611
diff
changeset
|
443 (put-text-property namestart (length string) |
4e76332f7b44
(summarize-tar-header-block): Add mouse-face properties.
Karl Heuer <kwzh@gnu.org>
parents:
6611
diff
changeset
|
444 'mouse-face 'highlight string) |
212 | 445 string))) |
446 | |
447 | |
448 (defun tar-summarize-buffer () | |
4387
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
449 "Parse the contents of the tar file in the current buffer. |
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
450 Place a dired-like listing on the front; |
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
451 then narrow to it, so that only that listing |
212 | 452 is visible (and the real data of the buffer is hidden)." |
23716
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
453 (set-buffer-multibyte nil) |
11450
aee30032f324
(tar-mode): Locally bind next-line-add-newlines to nil.
Richard M. Stallman <rms@gnu.org>
parents:
11431
diff
changeset
|
454 (message "Parsing tar file...") |
212 | 455 (let* ((result '()) |
456 (pos 1) | |
457 (bs (max 1 (- (buffer-size) 1024))) ; always 2+ empty blocks at end. | |
458 (bs100 (max 1 (/ bs 100))) | |
9724
193eeb5e78aa
(tar-summarize-buffer): Improperly terminated archive now produces only a
Karl Heuer <kwzh@gnu.org>
parents:
9698
diff
changeset
|
459 tokens) |
193eeb5e78aa
(tar-summarize-buffer): Improperly terminated archive now produces only a
Karl Heuer <kwzh@gnu.org>
parents:
9698
diff
changeset
|
460 (while (and (<= (+ pos 512) (point-max)) |
193eeb5e78aa
(tar-summarize-buffer): Improperly terminated archive now produces only a
Karl Heuer <kwzh@gnu.org>
parents:
9698
diff
changeset
|
461 (not (eq 'empty-tar-block |
193eeb5e78aa
(tar-summarize-buffer): Improperly terminated archive now produces only a
Karl Heuer <kwzh@gnu.org>
parents:
9698
diff
changeset
|
462 (setq tokens |
193eeb5e78aa
(tar-summarize-buffer): Improperly terminated archive now produces only a
Karl Heuer <kwzh@gnu.org>
parents:
9698
diff
changeset
|
463 (tar-header-block-tokenize |
193eeb5e78aa
(tar-summarize-buffer): Improperly terminated archive now produces only a
Karl Heuer <kwzh@gnu.org>
parents:
9698
diff
changeset
|
464 (buffer-substring pos (+ pos 512))))))) |
9698
b321ed01c3dc
(tar-summarize-buffer): Check for end of buffer before extracting substring.
Karl Heuer <kwzh@gnu.org>
parents:
8043
diff
changeset
|
465 (setq pos (+ pos 512)) |
9724
193eeb5e78aa
(tar-summarize-buffer): Improperly terminated archive now produces only a
Karl Heuer <kwzh@gnu.org>
parents:
9698
diff
changeset
|
466 (message "Parsing tar file...%d%%" |
9698
b321ed01c3dc
(tar-summarize-buffer): Check for end of buffer before extracting substring.
Karl Heuer <kwzh@gnu.org>
parents:
8043
diff
changeset
|
467 ;(/ (* pos 100) bs) ; this gets round-off lossage |
b321ed01c3dc
(tar-summarize-buffer): Check for end of buffer before extracting substring.
Karl Heuer <kwzh@gnu.org>
parents:
8043
diff
changeset
|
468 (/ pos bs100) ; this doesn't |
b321ed01c3dc
(tar-summarize-buffer): Check for end of buffer before extracting substring.
Karl Heuer <kwzh@gnu.org>
parents:
8043
diff
changeset
|
469 ) |
9724
193eeb5e78aa
(tar-summarize-buffer): Improperly terminated archive now produces only a
Karl Heuer <kwzh@gnu.org>
parents:
9698
diff
changeset
|
470 (if (eq (tar-header-link-type tokens) 20) |
193eeb5e78aa
(tar-summarize-buffer): Improperly terminated archive now produces only a
Karl Heuer <kwzh@gnu.org>
parents:
9698
diff
changeset
|
471 ;; Foo. There's an extra empty block after these. |
193eeb5e78aa
(tar-summarize-buffer): Improperly terminated archive now produces only a
Karl Heuer <kwzh@gnu.org>
parents:
9698
diff
changeset
|
472 (setq pos (+ pos 512))) |
193eeb5e78aa
(tar-summarize-buffer): Improperly terminated archive now produces only a
Karl Heuer <kwzh@gnu.org>
parents:
9698
diff
changeset
|
473 (let ((size (tar-header-size tokens))) |
193eeb5e78aa
(tar-summarize-buffer): Improperly terminated archive now produces only a
Karl Heuer <kwzh@gnu.org>
parents:
9698
diff
changeset
|
474 (if (< size 0) |
193eeb5e78aa
(tar-summarize-buffer): Improperly terminated archive now produces only a
Karl Heuer <kwzh@gnu.org>
parents:
9698
diff
changeset
|
475 (error "%s has size %s - corrupted" |
193eeb5e78aa
(tar-summarize-buffer): Improperly terminated archive now produces only a
Karl Heuer <kwzh@gnu.org>
parents:
9698
diff
changeset
|
476 (tar-header-name tokens) size)) |
193eeb5e78aa
(tar-summarize-buffer): Improperly terminated archive now produces only a
Karl Heuer <kwzh@gnu.org>
parents:
9698
diff
changeset
|
477 ; |
193eeb5e78aa
(tar-summarize-buffer): Improperly terminated archive now produces only a
Karl Heuer <kwzh@gnu.org>
parents:
9698
diff
changeset
|
478 ; This is just too slow. Don't really need it anyway.... |
193eeb5e78aa
(tar-summarize-buffer): Improperly terminated archive now produces only a
Karl Heuer <kwzh@gnu.org>
parents:
9698
diff
changeset
|
479 ;(tar-header-block-check-checksum |
193eeb5e78aa
(tar-summarize-buffer): Improperly terminated archive now produces only a
Karl Heuer <kwzh@gnu.org>
parents:
9698
diff
changeset
|
480 ; hblock (tar-header-block-checksum hblock) |
193eeb5e78aa
(tar-summarize-buffer): Improperly terminated archive now produces only a
Karl Heuer <kwzh@gnu.org>
parents:
9698
diff
changeset
|
481 ; (tar-header-name tokens)) |
9698
b321ed01c3dc
(tar-summarize-buffer): Check for end of buffer before extracting substring.
Karl Heuer <kwzh@gnu.org>
parents:
8043
diff
changeset
|
482 |
9724
193eeb5e78aa
(tar-summarize-buffer): Improperly terminated archive now produces only a
Karl Heuer <kwzh@gnu.org>
parents:
9698
diff
changeset
|
483 (setq result (cons (make-tar-desc pos tokens) result)) |
9698
b321ed01c3dc
(tar-summarize-buffer): Check for end of buffer before extracting substring.
Karl Heuer <kwzh@gnu.org>
parents:
8043
diff
changeset
|
484 |
9724
193eeb5e78aa
(tar-summarize-buffer): Improperly terminated archive now produces only a
Karl Heuer <kwzh@gnu.org>
parents:
9698
diff
changeset
|
485 (and (null (tar-header-link-type tokens)) |
193eeb5e78aa
(tar-summarize-buffer): Improperly terminated archive now produces only a
Karl Heuer <kwzh@gnu.org>
parents:
9698
diff
changeset
|
486 (> size 0) |
193eeb5e78aa
(tar-summarize-buffer): Improperly terminated archive now produces only a
Karl Heuer <kwzh@gnu.org>
parents:
9698
diff
changeset
|
487 (setq pos |
193eeb5e78aa
(tar-summarize-buffer): Improperly terminated archive now produces only a
Karl Heuer <kwzh@gnu.org>
parents:
9698
diff
changeset
|
488 (+ pos 512 (ash (ash (1- size) -9) 9)) ; this works |
193eeb5e78aa
(tar-summarize-buffer): Improperly terminated archive now produces only a
Karl Heuer <kwzh@gnu.org>
parents:
9698
diff
changeset
|
489 ;(+ pos (+ size (- 512 (rem (1- size) 512)))) ; this doesn't |
193eeb5e78aa
(tar-summarize-buffer): Improperly terminated archive now produces only a
Karl Heuer <kwzh@gnu.org>
parents:
9698
diff
changeset
|
490 )))) |
212 | 491 (make-local-variable 'tar-parse-info) |
9724
193eeb5e78aa
(tar-summarize-buffer): Improperly terminated archive now produces only a
Karl Heuer <kwzh@gnu.org>
parents:
9698
diff
changeset
|
492 (setq tar-parse-info (nreverse result)) |
193eeb5e78aa
(tar-summarize-buffer): Improperly terminated archive now produces only a
Karl Heuer <kwzh@gnu.org>
parents:
9698
diff
changeset
|
493 ;; A tar file should end with a block or two of nulls, |
193eeb5e78aa
(tar-summarize-buffer): Improperly terminated archive now produces only a
Karl Heuer <kwzh@gnu.org>
parents:
9698
diff
changeset
|
494 ;; but let's not get a fatal error if it doesn't. |
193eeb5e78aa
(tar-summarize-buffer): Improperly terminated archive now produces only a
Karl Heuer <kwzh@gnu.org>
parents:
9698
diff
changeset
|
495 (if (eq tokens 'empty-tar-block) |
14294
f8eba77ccb7f
(tar-summarize-buffer): Fix "done" message.
Karl Heuer <kwzh@gnu.org>
parents:
14174
diff
changeset
|
496 (message "Parsing tar file...done") |
9724
193eeb5e78aa
(tar-summarize-buffer): Improperly terminated archive now produces only a
Karl Heuer <kwzh@gnu.org>
parents:
9698
diff
changeset
|
497 (message "Warning: premature EOF parsing tar file"))) |
212 | 498 (save-excursion |
499 (goto-char (point-min)) | |
14174
b986e1fb97a5
(tar-summarize-buffer): Speed-up for large files.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
500 (let ((buffer-read-only nil) |
b986e1fb97a5
(tar-summarize-buffer): Speed-up for large files.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
501 (summaries nil)) |
b986e1fb97a5
(tar-summarize-buffer): Speed-up for large files.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
502 ;; Collect summary lines and insert them all at once since tar files |
b986e1fb97a5
(tar-summarize-buffer): Speed-up for large files.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
503 ;; can be pretty big. |
14294
f8eba77ccb7f
(tar-summarize-buffer): Fix "done" message.
Karl Heuer <kwzh@gnu.org>
parents:
14174
diff
changeset
|
504 (tar-dolist (tar-desc (reverse tar-parse-info)) |
14174
b986e1fb97a5
(tar-summarize-buffer): Speed-up for large files.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
505 (setq summaries |
b986e1fb97a5
(tar-summarize-buffer): Speed-up for large files.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
506 (cons (tar-header-block-summarize (tar-desc-tokens tar-desc)) |
b986e1fb97a5
(tar-summarize-buffer): Speed-up for large files.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
507 (cons "\n" |
b986e1fb97a5
(tar-summarize-buffer): Speed-up for large files.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
508 summaries)))) |
23716
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
509 (let ((total-summaries (apply 'concat summaries))) |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
510 (if (multibyte-string-p total-summaries) |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
511 (set-buffer-multibyte t)) |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
512 (insert total-summaries)) |
212 | 513 (make-local-variable 'tar-header-offset) |
514 (setq tar-header-offset (point)) | |
515 (narrow-to-region 1 tar-header-offset) | |
23716
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
516 (if enable-multibyte-characters |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
517 (setq tar-header-offset (position-bytes tar-header-offset))) |
9724
193eeb5e78aa
(tar-summarize-buffer): Improperly terminated archive now produces only a
Karl Heuer <kwzh@gnu.org>
parents:
9698
diff
changeset
|
518 (set-buffer-modified-p nil)))) |
4387
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
519 |
6611
a5f180172ff3
Fix error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
5821
diff
changeset
|
520 (defvar tar-mode-map nil "*Local keymap for Tar mode listings.") |
212 | 521 |
522 (if tar-mode-map | |
523 nil | |
524 (setq tar-mode-map (make-keymap)) | |
525 (suppress-keymap tar-mode-map) | |
526 (define-key tar-mode-map " " 'tar-next-line) | |
20970
00fce41bcd4f
Add "q" for quit, and use "C" for copy and "R" for
Karl Heuer <kwzh@gnu.org>
parents:
20808
diff
changeset
|
527 (define-key tar-mode-map "C" 'tar-copy) |
212 | 528 (define-key tar-mode-map "d" 'tar-flag-deleted) |
529 (define-key tar-mode-map "\^D" 'tar-flag-deleted) | |
530 (define-key tar-mode-map "e" 'tar-extract) | |
531 (define-key tar-mode-map "f" 'tar-extract) | |
10271
d20db86b0c0c
(tar-mode-map): Bind C-m to tar-extract.
Richard M. Stallman <rms@gnu.org>
parents:
10188
diff
changeset
|
532 (define-key tar-mode-map "\C-m" 'tar-extract) |
6611
a5f180172ff3
Fix error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
5821
diff
changeset
|
533 (define-key tar-mode-map [mouse-2] 'tar-mouse-extract) |
212 | 534 (define-key tar-mode-map "g" 'revert-buffer) |
535 (define-key tar-mode-map "h" 'describe-mode) | |
536 (define-key tar-mode-map "n" 'tar-next-line) | |
537 (define-key tar-mode-map "\^N" 'tar-next-line) | |
15612
9b55a88233d1
(tar-mode-map): Bind up and down like C-p, C-n.
Miles Bader <miles@gnu.org>
parents:
15424
diff
changeset
|
538 (define-key tar-mode-map [down] 'tar-next-line) |
212 | 539 (define-key tar-mode-map "o" 'tar-extract-other-window) |
540 (define-key tar-mode-map "p" 'tar-previous-line) | |
20970
00fce41bcd4f
Add "q" for quit, and use "C" for copy and "R" for
Karl Heuer <kwzh@gnu.org>
parents:
20808
diff
changeset
|
541 (define-key tar-mode-map "q" 'tar-quit) |
212 | 542 (define-key tar-mode-map "\^P" 'tar-previous-line) |
15612
9b55a88233d1
(tar-mode-map): Bind up and down like C-p, C-n.
Miles Bader <miles@gnu.org>
parents:
15424
diff
changeset
|
543 (define-key tar-mode-map [up] 'tar-previous-line) |
20970
00fce41bcd4f
Add "q" for quit, and use "C" for copy and "R" for
Karl Heuer <kwzh@gnu.org>
parents:
20808
diff
changeset
|
544 (define-key tar-mode-map "R" 'tar-rename-entry) |
212 | 545 (define-key tar-mode-map "u" 'tar-unflag) |
546 (define-key tar-mode-map "v" 'tar-view) | |
547 (define-key tar-mode-map "x" 'tar-expunge) | |
548 (define-key tar-mode-map "\177" 'tar-unflag-backwards) | |
549 (define-key tar-mode-map "E" 'tar-extract-other-window) | |
550 (define-key tar-mode-map "M" 'tar-chmod-entry) | |
551 (define-key tar-mode-map "G" 'tar-chgrp-entry) | |
552 (define-key tar-mode-map "O" 'tar-chown-entry) | |
553 ) | |
4387
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
554 |
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
555 ;; Make menu bar items. |
212 | 556 |
4387
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
557 ;; Get rid of the Edit menu bar item to save space. |
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
558 (define-key tar-mode-map [menu-bar edit] 'undefined) |
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
559 |
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
560 (define-key tar-mode-map [menu-bar immediate] |
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
561 (cons "Immediate" (make-sparse-keymap "Immediate"))) |
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
562 |
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
563 (define-key tar-mode-map [menu-bar immediate view] |
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
564 '("View This File" . tar-view)) |
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
565 (define-key tar-mode-map [menu-bar immediate display] |
20254
d1b61f2a6701
(tar-mode-map): Fix function name in menu entry.
Andreas Schwab <schwab@suse.de>
parents:
18287
diff
changeset
|
566 '("Display in Other Window" . tar-display-other-window)) |
4387
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
567 (define-key tar-mode-map [menu-bar immediate find-file-other-window] |
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
568 '("Find in Other Window" . tar-extract-other-window)) |
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
569 (define-key tar-mode-map [menu-bar immediate find-file] |
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
570 '("Find This File" . tar-extract)) |
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
571 |
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
572 (define-key tar-mode-map [menu-bar mark] |
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
573 (cons "Mark" (make-sparse-keymap "Mark"))) |
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
574 |
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
575 (define-key tar-mode-map [menu-bar mark unmark-all] |
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
576 '("Unmark All" . tar-clear-modification-flags)) |
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
577 (define-key tar-mode-map [menu-bar mark deletion] |
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
578 '("Flag" . tar-flag-deleted)) |
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
579 (define-key tar-mode-map [menu-bar mark unmark] |
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
580 '("Unflag" . tar-unflag)) |
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
581 |
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
582 (define-key tar-mode-map [menu-bar operate] |
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
583 (cons "Operate" (make-sparse-keymap "Operate"))) |
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
584 |
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
585 (define-key tar-mode-map [menu-bar operate chown] |
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
586 '("Change Owner..." . tar-chown-entry)) |
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
587 (define-key tar-mode-map [menu-bar operate chgrp] |
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
588 '("Change Group..." . tar-chgrp-entry)) |
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
589 (define-key tar-mode-map [menu-bar operate chmod] |
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
590 '("Change Mode..." . tar-chmod-entry)) |
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
591 (define-key tar-mode-map [menu-bar operate rename] |
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
592 '("Rename to..." . tar-rename-entry)) |
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
593 (define-key tar-mode-map [menu-bar operate copy] |
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
594 '("Copy to..." . tar-copy)) |
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
595 (define-key tar-mode-map [menu-bar operate expunge] |
12027
d5a2fb3235ef
(tar-mode-map): Fix capitalization in menu bar.
Karl Heuer <kwzh@gnu.org>
parents:
11847
diff
changeset
|
596 '("Expunge Marked Files" . tar-expunge)) |
4387
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
597 |
212 | 598 ;; tar mode is suitable only for specially formatted data. |
599 (put 'tar-mode 'mode-class 'special) | |
600 (put 'tar-subfile-mode 'mode-class 'special) | |
601 | |
3419
97205883b02d
Typo in autoload cookie.
Richard M. Stallman <rms@gnu.org>
parents:
3365
diff
changeset
|
602 ;;;###autoload |
212 | 603 (defun tar-mode () |
604 "Major mode for viewing a tar file as a dired-like listing of its contents. | |
605 You can move around using the usual cursor motion commands. | |
606 Letters no longer insert themselves. | |
6611
a5f180172ff3
Fix error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
5821
diff
changeset
|
607 Type `e' to pull a file out of the tar file and into its own buffer; |
a5f180172ff3
Fix error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
5821
diff
changeset
|
608 or click mouse-2 on the file's line in the Tar mode buffer. |
4387
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
609 Type `c' to copy an entry from the tar file into another file on disk. |
212 | 610 |
4387
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
611 If you edit a sub-file of this archive (as with the `e' command) and |
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
612 save it with Control-x Control-s, the contents of that buffer will be |
212 | 613 saved back into the tar-file buffer; in this way you can edit a file |
614 inside of a tar archive without extracting it and re-archiving it. | |
615 | |
4387
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
616 See also: variables `tar-update-datestamp' and `tar-anal-blocksize'. |
212 | 617 \\{tar-mode-map}" |
618 ;; this is not interactive because you shouldn't be turning this | |
619 ;; mode on and off. You can corrupt things that way. | |
4260
e0713a13f2d7
(tar-parse-info, tar-header-offset, tar-superior-buffer)
Richard M. Stallman <rms@gnu.org>
parents:
4120
diff
changeset
|
620 ;; rms: with permanent locals, it should now be possible to make this work |
e0713a13f2d7
(tar-parse-info, tar-header-offset, tar-superior-buffer)
Richard M. Stallman <rms@gnu.org>
parents:
4120
diff
changeset
|
621 ;; interactively in some reasonable fashion. |
e0713a13f2d7
(tar-parse-info, tar-header-offset, tar-superior-buffer)
Richard M. Stallman <rms@gnu.org>
parents:
4120
diff
changeset
|
622 (kill-all-local-variables) |
212 | 623 (make-local-variable 'tar-header-offset) |
624 (make-local-variable 'tar-parse-info) | |
625 (make-local-variable 'require-final-newline) | |
626 (setq require-final-newline nil) ; binary data, dude... | |
627 (make-local-variable 'revert-buffer-function) | |
628 (setq revert-buffer-function 'tar-mode-revert) | |
22473
74e7682de297
(tar-mode): Locally bind local-enable-local-variables,
Richard M. Stallman <rms@gnu.org>
parents:
22305
diff
changeset
|
629 (make-local-variable 'local-enable-local-variables) |
74e7682de297
(tar-mode): Locally bind local-enable-local-variables,
Richard M. Stallman <rms@gnu.org>
parents:
22305
diff
changeset
|
630 (setq local-enable-local-variables nil) |
11450
aee30032f324
(tar-mode): Locally bind next-line-add-newlines to nil.
Richard M. Stallman <rms@gnu.org>
parents:
11431
diff
changeset
|
631 (make-local-variable 'next-line-add-newlines) |
aee30032f324
(tar-mode): Locally bind next-line-add-newlines to nil.
Richard M. Stallman <rms@gnu.org>
parents:
11431
diff
changeset
|
632 (setq next-line-add-newlines nil) |
23482
43849bed4a16
(tar-mode): Locally set file-precious-flag.
Richard M. Stallman <rms@gnu.org>
parents:
23380
diff
changeset
|
633 ;; Prevent loss of data when saving the file. |
43849bed4a16
(tar-mode): Locally set file-precious-flag.
Richard M. Stallman <rms@gnu.org>
parents:
23380
diff
changeset
|
634 (make-local-variable 'file-precious-flag) |
43849bed4a16
(tar-mode): Locally set file-precious-flag.
Richard M. Stallman <rms@gnu.org>
parents:
23380
diff
changeset
|
635 (setq file-precious-flag t) |
212 | 636 (setq major-mode 'tar-mode) |
637 (setq mode-name "Tar") | |
638 (use-local-map tar-mode-map) | |
639 (auto-save-mode 0) | |
11847
c5cf8807738b
(tar-mode): Set write-contents-hooks instead of
Karl Heuer <kwzh@gnu.org>
parents:
11450
diff
changeset
|
640 (make-local-variable 'write-contents-hooks) |
c5cf8807738b
(tar-mode): Set write-contents-hooks instead of
Karl Heuer <kwzh@gnu.org>
parents:
11450
diff
changeset
|
641 (setq write-contents-hooks '(tar-mode-write-file)) |
212 | 642 (widen) |
643 (if (and (boundp 'tar-header-offset) tar-header-offset) | |
23716
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
644 (narrow-to-region 1 (byte-to-position tar-header-offset)) |
22181
dc8c3736ebea
(tar-mode): Position point on the name of the first file.
Richard M. Stallman <rms@gnu.org>
parents:
22032
diff
changeset
|
645 (tar-summarize-buffer) |
dc8c3736ebea
(tar-mode): Position point on the name of the first file.
Richard M. Stallman <rms@gnu.org>
parents:
22032
diff
changeset
|
646 (tar-next-line 0)) |
212 | 647 (run-hooks 'tar-mode-hook) |
648 ) | |
649 | |
650 | |
651 (defun tar-subfile-mode (p) | |
652 "Minor mode for editing an element of a tar-file. | |
14769
acf049402d18
(tar-subfile-mode): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
14294
diff
changeset
|
653 This mode arranges for \"saving\" this buffer to write the data |
acf049402d18
(tar-subfile-mode): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
14294
diff
changeset
|
654 into the tar-file buffer that it came from. The changes will actually |
acf049402d18
(tar-subfile-mode): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
14294
diff
changeset
|
655 appear on disk when you save the tar-file's buffer." |
212 | 656 (interactive "P") |
2542
ae4176e2e8fa
Add defvars to pacify the byte compiler, at RMS's request.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
880
diff
changeset
|
657 (or (and (boundp 'tar-superior-buffer) tar-superior-buffer) |
4387
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
658 (error "This buffer is not an element of a tar file")) |
7078
cf120e7b7d2c
(tar-extract): Don't put whole file name in buffer name.
Richard M. Stallman <rms@gnu.org>
parents:
6641
diff
changeset
|
659 ;;; Don't do this, because it is redundant and wastes mode line space. |
cf120e7b7d2c
(tar-extract): Don't put whole file name in buffer name.
Richard M. Stallman <rms@gnu.org>
parents:
6641
diff
changeset
|
660 ;;; (or (assq 'tar-subfile-mode minor-mode-alist) |
cf120e7b7d2c
(tar-extract): Don't put whole file name in buffer name.
Richard M. Stallman <rms@gnu.org>
parents:
6641
diff
changeset
|
661 ;;; (setq minor-mode-alist (append minor-mode-alist |
cf120e7b7d2c
(tar-extract): Don't put whole file name in buffer name.
Richard M. Stallman <rms@gnu.org>
parents:
6641
diff
changeset
|
662 ;;; (list '(tar-subfile-mode " TarFile"))))) |
212 | 663 (make-local-variable 'tar-subfile-mode) |
664 (setq tar-subfile-mode | |
665 (if (null p) | |
666 (not tar-subfile-mode) | |
667 (> (prefix-numeric-value p) 0))) | |
668 (cond (tar-subfile-mode | |
4387
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
669 (make-local-variable 'local-write-file-hooks) |
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
670 (setq local-write-file-hooks '(tar-subfile-save-buffer)) |
212 | 671 ;; turn off auto-save. |
22032
e27e9e844efe
(tar-subfile-mode): Call auto-save-mode with -1.
Dave Love <fx@gnu.org>
parents:
21851
diff
changeset
|
672 (auto-save-mode -1) |
212 | 673 (setq buffer-auto-save-file-name nil) |
674 (run-hooks 'tar-subfile-mode-hook)) | |
4387
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
675 (t |
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
676 (kill-local-variable 'local-write-file-hooks)))) |
212 | 677 |
678 | |
4387
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
679 ;; Revert the buffer and recompute the dired-like listing. |
23380
0088626fec1c
(tar-mode-revert): no-auto-save arg renamed from no-autosave.
Karl Heuer <kwzh@gnu.org>
parents:
22810
diff
changeset
|
680 (defun tar-mode-revert (&optional no-auto-save no-confirm) |
15424
85a85480fa3c
(tar-mode-revert): Cope if user cancels the revert.
Richard M. Stallman <rms@gnu.org>
parents:
14769
diff
changeset
|
681 (let ((revert-buffer-function nil) |
85a85480fa3c
(tar-mode-revert): Cope if user cancels the revert.
Richard M. Stallman <rms@gnu.org>
parents:
14769
diff
changeset
|
682 (old-offset tar-header-offset) |
85a85480fa3c
(tar-mode-revert): Cope if user cancels the revert.
Richard M. Stallman <rms@gnu.org>
parents:
14769
diff
changeset
|
683 success) |
85a85480fa3c
(tar-mode-revert): Cope if user cancels the revert.
Richard M. Stallman <rms@gnu.org>
parents:
14769
diff
changeset
|
684 (setq tar-header-offset nil) |
85a85480fa3c
(tar-mode-revert): Cope if user cancels the revert.
Richard M. Stallman <rms@gnu.org>
parents:
14769
diff
changeset
|
685 (unwind-protect |
85a85480fa3c
(tar-mode-revert): Cope if user cancels the revert.
Richard M. Stallman <rms@gnu.org>
parents:
14769
diff
changeset
|
686 (and (revert-buffer t no-confirm) |
85a85480fa3c
(tar-mode-revert): Cope if user cancels the revert.
Richard M. Stallman <rms@gnu.org>
parents:
14769
diff
changeset
|
687 (progn (widen) |
85a85480fa3c
(tar-mode-revert): Cope if user cancels the revert.
Richard M. Stallman <rms@gnu.org>
parents:
14769
diff
changeset
|
688 (setq success t) |
85a85480fa3c
(tar-mode-revert): Cope if user cancels the revert.
Richard M. Stallman <rms@gnu.org>
parents:
14769
diff
changeset
|
689 (tar-mode))) |
85a85480fa3c
(tar-mode-revert): Cope if user cancels the revert.
Richard M. Stallman <rms@gnu.org>
parents:
14769
diff
changeset
|
690 ;; If the revert was canceled, |
85a85480fa3c
(tar-mode-revert): Cope if user cancels the revert.
Richard M. Stallman <rms@gnu.org>
parents:
14769
diff
changeset
|
691 ;; put back the old value of tar-header-offset. |
85a85480fa3c
(tar-mode-revert): Cope if user cancels the revert.
Richard M. Stallman <rms@gnu.org>
parents:
14769
diff
changeset
|
692 (or success |
85a85480fa3c
(tar-mode-revert): Cope if user cancels the revert.
Richard M. Stallman <rms@gnu.org>
parents:
14769
diff
changeset
|
693 (setq tar-header-offset old-offset))))) |
212 | 694 |
695 | |
696 (defun tar-next-line (p) | |
697 (interactive "p") | |
698 (forward-line p) | |
10843
2f2e5033b3bb
(tar-header-block-tokenize): Parse 32-bit modtime
Richard M. Stallman <rms@gnu.org>
parents:
10271
diff
changeset
|
699 (if (eobp) nil (forward-char (if tar-mode-show-date 54 36)))) |
212 | 700 |
701 (defun tar-previous-line (p) | |
702 (interactive "p") | |
703 (tar-next-line (- p))) | |
704 | |
705 (defun tar-current-descriptor (&optional noerror) | |
4387
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
706 "Return the tar-descriptor of the current line, or signals an error." |
212 | 707 ;; I wish lines had plists, like in ZMACS... |
708 (or (nth (count-lines (point-min) | |
709 (save-excursion (beginning-of-line) (point))) | |
710 tar-parse-info) | |
711 (if noerror | |
712 nil | |
6611
a5f180172ff3
Fix error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
5821
diff
changeset
|
713 (error "This line does not describe a tar-file entry")))) |
212 | 714 |
6611
a5f180172ff3
Fix error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
5821
diff
changeset
|
715 (defun tar-get-descriptor () |
a5f180172ff3
Fix error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
5821
diff
changeset
|
716 (let* ((descriptor (tar-current-descriptor)) |
212 | 717 (tokens (tar-desc-tokens descriptor)) |
718 (size (tar-header-size tokens)) | |
6611
a5f180172ff3
Fix error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
5821
diff
changeset
|
719 (link-p (tar-header-link-type tokens))) |
212 | 720 (if link-p |
6611
a5f180172ff3
Fix error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
5821
diff
changeset
|
721 (error "This is a %s, not a real file" |
212 | 722 (cond ((eq link-p 5) "directory") |
723 ((eq link-p 20) "tar directory header") | |
724 ((eq link-p 29) "multivolume-continuation") | |
725 ((eq link-p 35) "sparse entry") | |
726 ((eq link-p 38) "volume header") | |
727 (t "link")))) | |
6611
a5f180172ff3
Fix error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
5821
diff
changeset
|
728 (if (zerop size) (error "This is a zero-length file")) |
a5f180172ff3
Fix error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
5821
diff
changeset
|
729 descriptor)) |
a5f180172ff3
Fix error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
5821
diff
changeset
|
730 |
a5f180172ff3
Fix error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
5821
diff
changeset
|
731 (defun tar-mouse-extract (event) |
a5f180172ff3
Fix error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
5821
diff
changeset
|
732 "Extract a file whose tar directory line you click on." |
a5f180172ff3
Fix error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
5821
diff
changeset
|
733 (interactive "e") |
a5f180172ff3
Fix error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
5821
diff
changeset
|
734 (save-excursion |
a5f180172ff3
Fix error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
5821
diff
changeset
|
735 (set-buffer (window-buffer (posn-window (event-end event)))) |
a5f180172ff3
Fix error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
5821
diff
changeset
|
736 (save-excursion |
a5f180172ff3
Fix error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
5821
diff
changeset
|
737 (goto-char (posn-point (event-end event))) |
a5f180172ff3
Fix error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
5821
diff
changeset
|
738 ;; Just make sure this doesn't get an error. |
a5f180172ff3
Fix error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
5821
diff
changeset
|
739 (tar-get-descriptor))) |
a5f180172ff3
Fix error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
5821
diff
changeset
|
740 (select-window (posn-window (event-end event))) |
a5f180172ff3
Fix error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
5821
diff
changeset
|
741 (goto-char (posn-point (event-end event))) |
a5f180172ff3
Fix error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
5821
diff
changeset
|
742 (tar-extract)) |
a5f180172ff3
Fix error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
5821
diff
changeset
|
743 |
a5f180172ff3
Fix error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
5821
diff
changeset
|
744 (defun tar-extract (&optional other-window-p) |
a5f180172ff3
Fix error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
5821
diff
changeset
|
745 "In Tar mode, extract this entry of the tar file into its own buffer." |
a5f180172ff3
Fix error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
5821
diff
changeset
|
746 (interactive) |
a5f180172ff3
Fix error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
5821
diff
changeset
|
747 (let* ((view-p (eq other-window-p 'view)) |
a5f180172ff3
Fix error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
5821
diff
changeset
|
748 (descriptor (tar-get-descriptor)) |
a5f180172ff3
Fix error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
5821
diff
changeset
|
749 (tokens (tar-desc-tokens descriptor)) |
a5f180172ff3
Fix error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
5821
diff
changeset
|
750 (name (tar-header-name tokens)) |
a5f180172ff3
Fix error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
5821
diff
changeset
|
751 (size (tar-header-size tokens)) |
a5f180172ff3
Fix error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
5821
diff
changeset
|
752 (start (+ (tar-desc-data-start descriptor) tar-header-offset -1)) |
a5f180172ff3
Fix error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
5821
diff
changeset
|
753 (end (+ start size))) |
212 | 754 (let* ((tar-buffer (current-buffer)) |
23716
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
755 (tar-buffer-multibyte enable-multibyte-characters) |
7078
cf120e7b7d2c
(tar-extract): Don't put whole file name in buffer name.
Richard M. Stallman <rms@gnu.org>
parents:
6641
diff
changeset
|
756 (tarname (file-name-nondirectory (buffer-file-name))) |
212 | 757 (bufname (concat (file-name-nondirectory name) |
7078
cf120e7b7d2c
(tar-extract): Don't put whole file name in buffer name.
Richard M. Stallman <rms@gnu.org>
parents:
6641
diff
changeset
|
758 " (" |
cf120e7b7d2c
(tar-extract): Don't put whole file name in buffer name.
Richard M. Stallman <rms@gnu.org>
parents:
6641
diff
changeset
|
759 tarname |
212 | 760 ")")) |
761 (read-only-p (or buffer-read-only view-p)) | |
762 (buffer (get-buffer bufname)) | |
763 (just-created nil)) | |
764 (if buffer | |
765 nil | |
766 (setq buffer (get-buffer-create bufname)) | |
767 (setq just-created t) | |
768 (unwind-protect | |
769 (progn | |
770 (widen) | |
23716
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
771 (set-buffer-multibyte nil) |
212 | 772 (save-excursion |
773 (set-buffer buffer) | |
23716
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
774 (if enable-multibyte-characters |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
775 (progn |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
776 ;; We must avoid unibyte->multibyte conversion. |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
777 (set-buffer-multibyte nil) |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
778 (insert-buffer-substring tar-buffer start end) |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
779 (set-buffer-multibyte t)) |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
780 (insert-buffer-substring tar-buffer start end)) |
212 | 781 (goto-char 0) |
8023
f29df49c6e53
(tar-extract): Set file name by hand before calling
Richard M. Stallman <rms@gnu.org>
parents:
7497
diff
changeset
|
782 (setq buffer-file-name |
21850
96fc2ea42485
(tar-extract): Use `!' instead of `:' to construct
Richard M. Stallman <rms@gnu.org>
parents:
21045
diff
changeset
|
783 ;; `:' is not allowed on Windows |
96fc2ea42485
(tar-extract): Use `!' instead of `:' to construct
Richard M. Stallman <rms@gnu.org>
parents:
21045
diff
changeset
|
784 (expand-file-name (concat tarname "!" name))) |
10188
f837d768d569
(tar-extract): Don't use set-visited-file-name. to
Richard M. Stallman <rms@gnu.org>
parents:
9817
diff
changeset
|
785 (setq buffer-file-truename |
f837d768d569
(tar-extract): Don't use set-visited-file-name. to
Richard M. Stallman <rms@gnu.org>
parents:
9817
diff
changeset
|
786 (abbreviate-file-name buffer-file-name)) |
22181
dc8c3736ebea
(tar-mode): Position point on the name of the first file.
Richard M. Stallman <rms@gnu.org>
parents:
22032
diff
changeset
|
787 ;; We need to mimic the parts of insert-file-contents |
dc8c3736ebea
(tar-mode): Position point on the name of the first file.
Richard M. Stallman <rms@gnu.org>
parents:
22032
diff
changeset
|
788 ;; which determine the coding-system and decode the text. |
dc8c3736ebea
(tar-mode): Position point on the name of the first file.
Richard M. Stallman <rms@gnu.org>
parents:
22032
diff
changeset
|
789 (let ((coding |
dc8c3736ebea
(tar-mode): Position point on the name of the first file.
Richard M. Stallman <rms@gnu.org>
parents:
22032
diff
changeset
|
790 (and set-auto-coding-function |
22494
486cf5c4541d
(tar-extract): Adjusted for the change of the spec
Kenichi Handa <handa@m17n.org>
parents:
22473
diff
changeset
|
791 (save-excursion |
22810
382a342ff901
Give set-auto-coding-funciton FILENAME argument.
Kenichi Handa <handa@m17n.org>
parents:
22494
diff
changeset
|
792 (funcall set-auto-coding-function |
382a342ff901
Give set-auto-coding-funciton FILENAME argument.
Kenichi Handa <handa@m17n.org>
parents:
22494
diff
changeset
|
793 name (point-max))))) |
22181
dc8c3736ebea
(tar-mode): Position point on the name of the first file.
Richard M. Stallman <rms@gnu.org>
parents:
22032
diff
changeset
|
794 (multibyte enable-multibyte-characters) |
dc8c3736ebea
(tar-mode): Position point on the name of the first file.
Richard M. Stallman <rms@gnu.org>
parents:
22032
diff
changeset
|
795 (detected (detect-coding-region |
22305
29da944dc29f
(tar-extract): Pass HIGHEST=t to detect-coding-region.
Karl Heuer <kwzh@gnu.org>
parents:
22181
diff
changeset
|
796 1 (min 16384 (point-max)) t))) |
22181
dc8c3736ebea
(tar-mode): Position point on the name of the first file.
Richard M. Stallman <rms@gnu.org>
parents:
22032
diff
changeset
|
797 (if coding |
dc8c3736ebea
(tar-mode): Position point on the name of the first file.
Richard M. Stallman <rms@gnu.org>
parents:
22032
diff
changeset
|
798 (or (numberp (coding-system-eol-type coding)) |
dc8c3736ebea
(tar-mode): Position point on the name of the first file.
Richard M. Stallman <rms@gnu.org>
parents:
22032
diff
changeset
|
799 (setq coding (coding-system-change-eol-conversion |
dc8c3736ebea
(tar-mode): Position point on the name of the first file.
Richard M. Stallman <rms@gnu.org>
parents:
22032
diff
changeset
|
800 coding |
dc8c3736ebea
(tar-mode): Position point on the name of the first file.
Richard M. Stallman <rms@gnu.org>
parents:
22032
diff
changeset
|
801 (coding-system-eol-type detected)))) |
dc8c3736ebea
(tar-mode): Position point on the name of the first file.
Richard M. Stallman <rms@gnu.org>
parents:
22032
diff
changeset
|
802 (setq coding |
dc8c3736ebea
(tar-mode): Position point on the name of the first file.
Richard M. Stallman <rms@gnu.org>
parents:
22032
diff
changeset
|
803 (or (find-new-buffer-file-coding-system detected) |
dc8c3736ebea
(tar-mode): Position point on the name of the first file.
Richard M. Stallman <rms@gnu.org>
parents:
22032
diff
changeset
|
804 (let ((file-coding |
dc8c3736ebea
(tar-mode): Position point on the name of the first file.
Richard M. Stallman <rms@gnu.org>
parents:
22032
diff
changeset
|
805 (find-operation-coding-system |
dc8c3736ebea
(tar-mode): Position point on the name of the first file.
Richard M. Stallman <rms@gnu.org>
parents:
22032
diff
changeset
|
806 'insert-file-contents buffer-file-name))) |
dc8c3736ebea
(tar-mode): Position point on the name of the first file.
Richard M. Stallman <rms@gnu.org>
parents:
22032
diff
changeset
|
807 (if (consp file-coding) |
dc8c3736ebea
(tar-mode): Position point on the name of the first file.
Richard M. Stallman <rms@gnu.org>
parents:
22032
diff
changeset
|
808 (setq file-coding (car file-coding)) |
dc8c3736ebea
(tar-mode): Position point on the name of the first file.
Richard M. Stallman <rms@gnu.org>
parents:
22032
diff
changeset
|
809 file-coding))))) |
dc8c3736ebea
(tar-mode): Position point on the name of the first file.
Richard M. Stallman <rms@gnu.org>
parents:
22032
diff
changeset
|
810 (if (or (eq coding 'no-conversion) |
dc8c3736ebea
(tar-mode): Position point on the name of the first file.
Richard M. Stallman <rms@gnu.org>
parents:
22032
diff
changeset
|
811 (eq (coding-system-type coding) 5)) |
dc8c3736ebea
(tar-mode): Position point on the name of the first file.
Richard M. Stallman <rms@gnu.org>
parents:
22032
diff
changeset
|
812 (setq multibyte (set-buffer-multibyte nil))) |
dc8c3736ebea
(tar-mode): Position point on the name of the first file.
Richard M. Stallman <rms@gnu.org>
parents:
22032
diff
changeset
|
813 (or multibyte |
dc8c3736ebea
(tar-mode): Position point on the name of the first file.
Richard M. Stallman <rms@gnu.org>
parents:
22032
diff
changeset
|
814 (setq coding |
dc8c3736ebea
(tar-mode): Position point on the name of the first file.
Richard M. Stallman <rms@gnu.org>
parents:
22032
diff
changeset
|
815 (coding-system-change-text-conversion |
dc8c3736ebea
(tar-mode): Position point on the name of the first file.
Richard M. Stallman <rms@gnu.org>
parents:
22032
diff
changeset
|
816 coding 'raw-text))) |
dc8c3736ebea
(tar-mode): Position point on the name of the first file.
Richard M. Stallman <rms@gnu.org>
parents:
22032
diff
changeset
|
817 (decode-coding-region 1 (point-max) coding) |
dc8c3736ebea
(tar-mode): Position point on the name of the first file.
Richard M. Stallman <rms@gnu.org>
parents:
22032
diff
changeset
|
818 (set-buffer-file-coding-system coding)) |
10188
f837d768d569
(tar-extract): Don't use set-visited-file-name. to
Richard M. Stallman <rms@gnu.org>
parents:
9817
diff
changeset
|
819 ;; Set the default-directory to the dir of the |
f837d768d569
(tar-extract): Don't use set-visited-file-name. to
Richard M. Stallman <rms@gnu.org>
parents:
9817
diff
changeset
|
820 ;; superior buffer. |
f837d768d569
(tar-extract): Don't use set-visited-file-name. to
Richard M. Stallman <rms@gnu.org>
parents:
9817
diff
changeset
|
821 (setq default-directory |
f837d768d569
(tar-extract): Don't use set-visited-file-name. to
Richard M. Stallman <rms@gnu.org>
parents:
9817
diff
changeset
|
822 (save-excursion |
f837d768d569
(tar-extract): Don't use set-visited-file-name. to
Richard M. Stallman <rms@gnu.org>
parents:
9817
diff
changeset
|
823 (set-buffer tar-buffer) |
f837d768d569
(tar-extract): Don't use set-visited-file-name. to
Richard M. Stallman <rms@gnu.org>
parents:
9817
diff
changeset
|
824 default-directory)) |
212 | 825 (normal-mode) ; pick a mode. |
826 (rename-buffer bufname) | |
2542
ae4176e2e8fa
Add defvars to pacify the byte compiler, at RMS's request.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
880
diff
changeset
|
827 (make-local-variable 'tar-superior-buffer) |
ae4176e2e8fa
Add defvars to pacify the byte compiler, at RMS's request.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
880
diff
changeset
|
828 (make-local-variable 'tar-superior-descriptor) |
ae4176e2e8fa
Add defvars to pacify the byte compiler, at RMS's request.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
880
diff
changeset
|
829 (setq tar-superior-buffer tar-buffer) |
ae4176e2e8fa
Add defvars to pacify the byte compiler, at RMS's request.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
880
diff
changeset
|
830 (setq tar-superior-descriptor descriptor) |
14769
acf049402d18
(tar-subfile-mode): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
14294
diff
changeset
|
831 (setq buffer-read-only read-only-p) |
acf049402d18
(tar-subfile-mode): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
14294
diff
changeset
|
832 (set-buffer-modified-p nil) |
acf049402d18
(tar-subfile-mode): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
14294
diff
changeset
|
833 (tar-subfile-mode 1)) |
212 | 834 (set-buffer tar-buffer)) |
23716
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
835 (narrow-to-region 1 tar-header-offset) |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
836 (set-buffer-multibyte tar-buffer-multibyte))) |
212 | 837 (if view-p |
18287
f55270c78210
(tar-extract): Use second argument of
Richard M. Stallman <rms@gnu.org>
parents:
15947
diff
changeset
|
838 (view-buffer buffer (and just-created 'kill-buffer)) |
4387
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
839 (if (eq other-window-p 'display) |
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
840 (display-buffer buffer) |
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
841 (if other-window-p |
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
842 (switch-to-buffer-other-window buffer) |
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
843 (switch-to-buffer buffer))))))) |
212 | 844 |
845 | |
846 (defun tar-extract-other-window () | |
4387
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
847 "*In Tar mode, find this entry of the tar file in another window." |
212 | 848 (interactive) |
849 (tar-extract t)) | |
850 | |
4387
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
851 (defun tar-display-other-window () |
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
852 "*In Tar mode, display this entry of the tar file in another window." |
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
853 (interactive) |
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
854 (tar-extract 'display)) |
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
855 |
212 | 856 (defun tar-view () |
4387
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
857 "*In Tar mode, view the tar file entry on this line." |
212 | 858 (interactive) |
859 (tar-extract 'view)) | |
860 | |
861 | |
862 (defun tar-read-file-name (&optional prompt) | |
4387
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
863 "Read a file name with this line's entry as the default." |
212 | 864 (or prompt (setq prompt "Copy to: ")) |
865 (let* ((default-file (expand-file-name | |
866 (tar-header-name (tar-desc-tokens | |
867 (tar-current-descriptor))))) | |
868 (target (expand-file-name | |
869 (read-file-name prompt | |
870 (file-name-directory default-file) | |
871 default-file nil)))) | |
872 (if (or (string= "" (file-name-nondirectory target)) | |
873 (file-directory-p target)) | |
874 (setq target (concat (if (string-match "/$" target) | |
875 (substring target 0 (1- (match-end 0))) | |
876 target) | |
877 "/" | |
878 (file-name-nondirectory default-file)))) | |
879 target)) | |
880 | |
881 | |
882 (defun tar-copy (&optional to-file) | |
4387
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
883 "*In Tar mode, extract this entry of the tar file into a file on disk. |
212 | 884 If TO-FILE is not supplied, it is prompted for, defaulting to the name of |
885 the current tar-entry." | |
886 (interactive (list (tar-read-file-name))) | |
6611
a5f180172ff3
Fix error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
5821
diff
changeset
|
887 (let* ((descriptor (tar-get-descriptor)) |
212 | 888 (tokens (tar-desc-tokens descriptor)) |
889 (name (tar-header-name tokens)) | |
890 (size (tar-header-size tokens)) | |
891 (start (+ (tar-desc-data-start descriptor) tar-header-offset -1)) | |
12662
07ba0f6e9ada
(tar-copy): Inhibit use of jka-compr handler
Richard M. Stallman <rms@gnu.org>
parents:
12027
diff
changeset
|
892 (end (+ start size)) |
23716
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
893 (multibyte enable-multibyte-characters) |
12662
07ba0f6e9ada
(tar-copy): Inhibit use of jka-compr handler
Richard M. Stallman <rms@gnu.org>
parents:
12027
diff
changeset
|
894 (inhibit-file-name-handlers inhibit-file-name-handlers) |
07ba0f6e9ada
(tar-copy): Inhibit use of jka-compr handler
Richard M. Stallman <rms@gnu.org>
parents:
12027
diff
changeset
|
895 (inhibit-file-name-operation inhibit-file-name-operation)) |
7090
cf0b24d47cdd
(tar-copy): Don't bother with a temp buffer.
Karl Heuer <kwzh@gnu.org>
parents:
7078
diff
changeset
|
896 (save-restriction |
cf0b24d47cdd
(tar-copy): Don't bother with a temp buffer.
Karl Heuer <kwzh@gnu.org>
parents:
7078
diff
changeset
|
897 (widen) |
12662
07ba0f6e9ada
(tar-copy): Inhibit use of jka-compr handler
Richard M. Stallman <rms@gnu.org>
parents:
12027
diff
changeset
|
898 ;; Inhibit compressing a subfile again if *both* name and |
07ba0f6e9ada
(tar-copy): Inhibit use of jka-compr handler
Richard M. Stallman <rms@gnu.org>
parents:
12027
diff
changeset
|
899 ;; to-file are handled by jka-compr |
07ba0f6e9ada
(tar-copy): Inhibit use of jka-compr handler
Richard M. Stallman <rms@gnu.org>
parents:
12027
diff
changeset
|
900 (if (and (eq (find-file-name-handler name 'write-region) 'jka-compr-handler) |
07ba0f6e9ada
(tar-copy): Inhibit use of jka-compr handler
Richard M. Stallman <rms@gnu.org>
parents:
12027
diff
changeset
|
901 (eq (find-file-name-handler to-file 'write-region) 'jka-compr-handler)) |
07ba0f6e9ada
(tar-copy): Inhibit use of jka-compr handler
Richard M. Stallman <rms@gnu.org>
parents:
12027
diff
changeset
|
902 (setq inhibit-file-name-handlers |
07ba0f6e9ada
(tar-copy): Inhibit use of jka-compr handler
Richard M. Stallman <rms@gnu.org>
parents:
12027
diff
changeset
|
903 (cons 'jka-compr-handler |
07ba0f6e9ada
(tar-copy): Inhibit use of jka-compr handler
Richard M. Stallman <rms@gnu.org>
parents:
12027
diff
changeset
|
904 (and (eq inhibit-file-name-operation 'write-region) |
07ba0f6e9ada
(tar-copy): Inhibit use of jka-compr handler
Richard M. Stallman <rms@gnu.org>
parents:
12027
diff
changeset
|
905 inhibit-file-name-handlers)) |
07ba0f6e9ada
(tar-copy): Inhibit use of jka-compr handler
Richard M. Stallman <rms@gnu.org>
parents:
12027
diff
changeset
|
906 inhibit-file-name-operation 'write-region)) |
23716
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
907 (unwind-protect |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
908 (let ((coding-system-for-write 'no-conversion)) |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
909 (set-buffer-multibyte nil) |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
910 (write-region start end to-file)) |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
911 (set-buffer-multibyte multibyte))) |
7090
cf0b24d47cdd
(tar-copy): Don't bother with a temp buffer.
Karl Heuer <kwzh@gnu.org>
parents:
7078
diff
changeset
|
912 (message "Copied tar entry %s to %s" name to-file))) |
212 | 913 |
914 (defun tar-flag-deleted (p &optional unflag) | |
4387
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
915 "*In Tar mode, mark this sub-file to be deleted from the tar file. |
212 | 916 With a prefix argument, mark that many files." |
917 (interactive "p") | |
918 (beginning-of-line) | |
919 (tar-dotimes (i (if (< p 0) (- p) p)) | |
920 (if (tar-current-descriptor unflag) ; barf if we're not on an entry-line. | |
921 (progn | |
922 (delete-char 1) | |
923 (insert (if unflag " " "D")))) | |
924 (forward-line (if (< p 0) -1 1))) | |
925 (if (eobp) nil (forward-char 36))) | |
926 | |
927 (defun tar-unflag (p) | |
4387
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
928 "*In Tar mode, un-mark this sub-file if it is marked to be deleted. |
212 | 929 With a prefix argument, un-mark that many files forward." |
930 (interactive "p") | |
931 (tar-flag-deleted p t)) | |
932 | |
933 (defun tar-unflag-backwards (p) | |
4387
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
934 "*In Tar mode, un-mark this sub-file if it is marked to be deleted. |
212 | 935 With a prefix argument, un-mark that many files backward." |
936 (interactive "p") | |
937 (tar-flag-deleted (- p) t)) | |
938 | |
939 | |
23716
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
940 ;; When this function is called, it is sure that the buffer is unibyte. |
212 | 941 (defun tar-expunge-internal () |
942 "Expunge the tar-entry specified by the current line." | |
943 (let* ((descriptor (tar-current-descriptor)) | |
944 (tokens (tar-desc-tokens descriptor)) | |
945 (line (tar-desc-data-start descriptor)) | |
946 (name (tar-header-name tokens)) | |
947 (size (tar-header-size tokens)) | |
948 (link-p (tar-header-link-type tokens)) | |
949 (start (tar-desc-data-start descriptor)) | |
950 (following-descs (cdr (memq descriptor tar-parse-info)))) | |
951 (if link-p (setq size 0)) ; size lies for hard-links. | |
952 ;; | |
953 ;; delete the current line... | |
954 (beginning-of-line) | |
955 (let ((line-start (point))) | |
956 (end-of-line) (forward-char) | |
957 (let ((line-len (- (point) line-start))) | |
958 (delete-region line-start (point)) | |
959 ;; | |
14040 | 960 ;; decrement the header-pointer to be in sync... |
212 | 961 (setq tar-header-offset (- tar-header-offset line-len)))) |
962 ;; | |
963 ;; delete the data pointer... | |
964 (setq tar-parse-info (delq descriptor tar-parse-info)) | |
965 ;; | |
966 ;; delete the data from inside the file... | |
967 (widen) | |
968 (let* ((data-start (+ start tar-header-offset -513)) | |
969 (data-end (+ data-start 512 (ash (ash (+ size 511) -9) 9)))) | |
970 (delete-region data-start data-end) | |
971 ;; | |
972 ;; and finally, decrement the start-pointers of all following | |
973 ;; entries in the archive. This is a pig when deleting a bunch | |
974 ;; of files at once - we could optimize this to only do the | |
975 ;; iteration over the files that remain, or only iterate up to | |
976 ;; the next file to be deleted. | |
977 (let ((data-length (- data-end data-start))) | |
978 (tar-dolist (desc following-descs) | |
979 (tar-setf (tar-desc-data-start desc) | |
980 (- (tar-desc-data-start desc) data-length)))) | |
981 )) | |
982 (narrow-to-region 1 tar-header-offset)) | |
983 | |
984 | |
985 (defun tar-expunge (&optional noconfirm) | |
4387
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
986 "*In Tar mode, delete all the archived files flagged for deletion. |
212 | 987 This does not modify the disk image; you must save the tar file itself |
988 for this to be permanent." | |
989 (interactive) | |
990 (if (or noconfirm | |
11450
aee30032f324
(tar-mode): Locally bind next-line-add-newlines to nil.
Richard M. Stallman <rms@gnu.org>
parents:
11431
diff
changeset
|
991 (y-or-n-p "Expunge files marked for deletion? ")) |
23716
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
992 (let ((n 0) |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
993 (multibyte enable-multibyte-characters)) |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
994 (set-buffer-multibyte nil) |
212 | 995 (save-excursion |
996 (goto-char 0) | |
997 (while (not (eobp)) | |
998 (if (looking-at "D") | |
999 (progn (tar-expunge-internal) | |
1000 (setq n (1+ n))) | |
1001 (forward-line 1))) | |
1002 ;; after doing the deletions, add any padding that may be necessary. | |
1003 (tar-pad-to-blocksize) | |
23716
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
1004 (narrow-to-region 1 tar-header-offset)) |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
1005 (set-buffer-multibyte multibyte) |
212 | 1006 (if (zerop n) |
11450
aee30032f324
(tar-mode): Locally bind next-line-add-newlines to nil.
Richard M. Stallman <rms@gnu.org>
parents:
11431
diff
changeset
|
1007 (message "Nothing to expunge.") |
aee30032f324
(tar-mode): Locally bind next-line-add-newlines to nil.
Richard M. Stallman <rms@gnu.org>
parents:
11431
diff
changeset
|
1008 (message "%s files expunged. Be sure to save this buffer." n))))) |
212 | 1009 |
1010 | |
1011 (defun tar-clear-modification-flags () | |
4387
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
1012 "Remove the stars at the beginning of each line." |
11301
1234d00b8492
(tar-clear-modification-flags): Fix several bugs.
Richard M. Stallman <rms@gnu.org>
parents:
11210
diff
changeset
|
1013 (interactive) |
212 | 1014 (save-excursion |
11301
1234d00b8492
(tar-clear-modification-flags): Fix several bugs.
Richard M. Stallman <rms@gnu.org>
parents:
11210
diff
changeset
|
1015 (goto-char 1) |
23716
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
1016 (while (< (position-bytes (point)) tar-header-offset) |
11301
1234d00b8492
(tar-clear-modification-flags): Fix several bugs.
Richard M. Stallman <rms@gnu.org>
parents:
11210
diff
changeset
|
1017 (if (not (eq (following-char) ?\ )) |
212 | 1018 (progn (delete-char 1) (insert " "))) |
1019 (forward-line 1)))) | |
1020 | |
1021 | |
1022 (defun tar-chown-entry (new-uid) | |
1023 "*Change the user-id associated with this entry in the tar file. | |
1024 If this tar file was written by GNU tar, then you will be able to edit | |
1025 the user id as a string; otherwise, you must edit it as a number. | |
1026 You can force editing as a number by calling this with a prefix arg. | |
1027 This does not modify the disk image; you must save the tar file itself | |
1028 for this to be permanent." | |
1029 (interactive (list | |
1030 (let ((tokens (tar-desc-tokens (tar-current-descriptor)))) | |
1031 (if (or current-prefix-arg | |
1032 (not (tar-header-magic tokens))) | |
1033 (let (n) | |
1034 (while (not (numberp (setq n (read-minibuffer | |
1035 "New UID number: " | |
1036 (format "%s" (tar-header-uid tokens))))))) | |
1037 n) | |
1038 (read-string "New UID string: " (tar-header-uname tokens)))))) | |
1039 (cond ((stringp new-uid) | |
1040 (tar-setf (tar-header-uname (tar-desc-tokens (tar-current-descriptor))) | |
1041 new-uid) | |
1042 (tar-alter-one-field tar-uname-offset (concat new-uid "\000"))) | |
1043 (t | |
1044 (tar-setf (tar-header-uid (tar-desc-tokens (tar-current-descriptor))) | |
1045 new-uid) | |
1046 (tar-alter-one-field tar-uid-offset | |
1047 (concat (substring (format "%6o" new-uid) 0 6) "\000 "))))) | |
1048 | |
1049 | |
1050 (defun tar-chgrp-entry (new-gid) | |
1051 "*Change the group-id associated with this entry in the tar file. | |
1052 If this tar file was written by GNU tar, then you will be able to edit | |
1053 the group id as a string; otherwise, you must edit it as a number. | |
1054 You can force editing as a number by calling this with a prefix arg. | |
1055 This does not modify the disk image; you must save the tar file itself | |
1056 for this to be permanent." | |
1057 (interactive (list | |
1058 (let ((tokens (tar-desc-tokens (tar-current-descriptor)))) | |
1059 (if (or current-prefix-arg | |
1060 (not (tar-header-magic tokens))) | |
1061 (let (n) | |
1062 (while (not (numberp (setq n (read-minibuffer | |
1063 "New GID number: " | |
1064 (format "%s" (tar-header-gid tokens))))))) | |
1065 n) | |
1066 (read-string "New GID string: " (tar-header-gname tokens)))))) | |
1067 (cond ((stringp new-gid) | |
1068 (tar-setf (tar-header-gname (tar-desc-tokens (tar-current-descriptor))) | |
1069 new-gid) | |
1070 (tar-alter-one-field tar-gname-offset | |
1071 (concat new-gid "\000"))) | |
1072 (t | |
1073 (tar-setf (tar-header-gid (tar-desc-tokens (tar-current-descriptor))) | |
1074 new-gid) | |
1075 (tar-alter-one-field tar-gid-offset | |
1076 (concat (substring (format "%6o" new-gid) 0 6) "\000 "))))) | |
1077 | |
1078 (defun tar-rename-entry (new-name) | |
1079 "*Change the name associated with this entry in the tar file. | |
1080 This does not modify the disk image; you must save the tar file itself | |
1081 for this to be permanent." | |
1082 (interactive | |
1083 (list (read-string "New name: " | |
1084 (tar-header-name (tar-desc-tokens (tar-current-descriptor)))))) | |
6611
a5f180172ff3
Fix error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
5821
diff
changeset
|
1085 (if (string= "" new-name) (error "zero length name")) |
a5f180172ff3
Fix error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
5821
diff
changeset
|
1086 (if (> (length new-name) 98) (error "name too long")) |
212 | 1087 (tar-setf (tar-header-name (tar-desc-tokens (tar-current-descriptor))) |
1088 new-name) | |
1089 (tar-alter-one-field 0 | |
1090 (substring (concat new-name (make-string 99 0)) 0 99))) | |
1091 | |
1092 | |
1093 (defun tar-chmod-entry (new-mode) | |
1094 "*Change the protection bits associated with this entry in the tar file. | |
1095 This does not modify the disk image; you must save the tar file itself | |
1096 for this to be permanent." | |
1097 (interactive (list (tar-parse-octal-integer-safe | |
1098 (read-string "New protection (octal): ")))) | |
1099 (tar-setf (tar-header-mode (tar-desc-tokens (tar-current-descriptor))) | |
1100 new-mode) | |
1101 (tar-alter-one-field tar-mode-offset | |
1102 (concat (substring (format "%6o" new-mode) 0 6) "\000 "))) | |
1103 | |
1104 | |
1105 (defun tar-alter-one-field (data-position new-data-string) | |
1106 (let* ((descriptor (tar-current-descriptor)) | |
23716
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
1107 (tokens (tar-desc-tokens descriptor)) |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
1108 (multibyte enable-multibyte-characters)) |
212 | 1109 (unwind-protect |
1110 (save-excursion | |
1111 ;; | |
1112 ;; update the header-line. | |
1113 (beginning-of-line) | |
1114 (let ((p (point))) | |
1115 (forward-line 1) | |
1116 (delete-region p (point)) | |
8023
f29df49c6e53
(tar-extract): Set file name by hand before calling
Richard M. Stallman <rms@gnu.org>
parents:
7497
diff
changeset
|
1117 (insert (tar-header-block-summarize tokens) "\n") |
23716
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
1118 (setq tar-header-offset (position-bytes (point-max)))) |
212 | 1119 |
1120 (widen) | |
23716
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
1121 (set-buffer-multibyte nil) |
212 | 1122 (let* ((start (+ (tar-desc-data-start descriptor) tar-header-offset -513))) |
1123 ;; | |
1124 ;; delete the old field and insert a new one. | |
1125 (goto-char (+ start data-position)) | |
1126 (delete-region (point) (+ (point) (length new-data-string))) ; <-- | |
1127 (insert new-data-string) ; <-- | |
1128 ;; | |
1129 ;; compute a new checksum and insert it. | |
8023
f29df49c6e53
(tar-extract): Set file name by hand before calling
Richard M. Stallman <rms@gnu.org>
parents:
7497
diff
changeset
|
1130 (let ((chk (tar-header-block-checksum |
212 | 1131 (buffer-substring start (+ start 512))))) |
1132 (goto-char (+ start tar-chk-offset)) | |
1133 (delete-region (point) (+ (point) 8)) | |
1134 (insert (format "%6o" chk)) | |
1135 (insert 0) | |
1136 (insert ? ) | |
1137 (tar-setf (tar-header-checksum tokens) chk) | |
1138 ;; | |
1139 ;; ok, make sure we didn't botch it. | |
8043
93beabc37a44
(tar-alter-one-field): Finish previous renaming change.
Richard M. Stallman <rms@gnu.org>
parents:
8023
diff
changeset
|
1140 (tar-header-block-check-checksum |
212 | 1141 (buffer-substring start (+ start 512)) |
1142 chk (tar-header-name tokens)) | |
1143 ))) | |
22181
dc8c3736ebea
(tar-mode): Position point on the name of the first file.
Richard M. Stallman <rms@gnu.org>
parents:
22032
diff
changeset
|
1144 (narrow-to-region 1 tar-header-offset) |
23716
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
1145 (set-buffer-multibyte multibyte) |
22181
dc8c3736ebea
(tar-mode): Position point on the name of the first file.
Richard M. Stallman <rms@gnu.org>
parents:
22032
diff
changeset
|
1146 (tar-next-line 0)))) |
212 | 1147 |
1148 | |
880 | 1149 (defun tar-octal-time (timeval) |
1150 ;; Format a timestamp as 11 octal digits. Ghod, I hope this works... | |
1151 (let ((hibits (car timeval)) (lobits (car (cdr timeval)))) | |
1152 (insert (format "%05o%01o%05o" | |
1153 (lsh hibits -2) | |
1154 (logior (lsh (logand 3 hibits) 1) (> (logand lobits 32768) 0)) | |
1155 (logand 32767 lobits) | |
1156 )))) | |
1157 | |
212 | 1158 (defun tar-subfile-save-buffer () |
4387
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
1159 "In tar subfile mode, save this buffer into its parent tar-file buffer. |
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
1160 This doesn't write anything to disk; you must save the parent tar-file buffer |
212 | 1161 to make your changes permanent." |
1162 (interactive) | |
2542
ae4176e2e8fa
Add defvars to pacify the byte compiler, at RMS's request.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
880
diff
changeset
|
1163 (if (not (and (boundp 'tar-superior-buffer) tar-superior-buffer)) |
6611
a5f180172ff3
Fix error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
5821
diff
changeset
|
1164 (error "This buffer has no superior tar file buffer")) |
2542
ae4176e2e8fa
Add defvars to pacify the byte compiler, at RMS's request.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
880
diff
changeset
|
1165 (if (not (and (boundp 'tar-superior-descriptor) tar-superior-descriptor)) |
6611
a5f180172ff3
Fix error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
5821
diff
changeset
|
1166 (error "This buffer doesn't have an index into its superior tar file!")) |
212 | 1167 (save-excursion |
1168 (let ((subfile (current-buffer)) | |
23716
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
1169 (subfile-multibyte enable-multibyte-characters) |
22181
dc8c3736ebea
(tar-mode): Position point on the name of the first file.
Richard M. Stallman <rms@gnu.org>
parents:
22032
diff
changeset
|
1170 (coding buffer-file-coding-system) |
23716
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
1171 (descriptor tar-superior-descriptor) |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
1172 subfile-size) |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
1173 ;; We must make the current buffer unibyte temporarily to avoid |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
1174 ;; multibyte->unibyte conversion in `insert-buffer'. |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
1175 (set-buffer-multibyte nil) |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
1176 (setq subfile-size (buffer-size)) |
2542
ae4176e2e8fa
Add defvars to pacify the byte compiler, at RMS's request.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
880
diff
changeset
|
1177 (set-buffer tar-superior-buffer) |
212 | 1178 (let* ((tokens (tar-desc-tokens descriptor)) |
1179 (start (tar-desc-data-start descriptor)) | |
1180 (name (tar-header-name tokens)) | |
1181 (size (tar-header-size tokens)) | |
1182 (size-pad (ash (ash (+ size 511) -9) 9)) | |
1183 (head (memq descriptor tar-parse-info)) | |
23716
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
1184 (following-descs (cdr head)) |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
1185 (tar-buffer-multibyte enable-multibyte-characters)) |
212 | 1186 (if (not head) |
1187 (error "Can't find this tar file entry in its parent tar file!")) | |
1188 (unwind-protect | |
1189 (save-excursion | |
1190 (widen) | |
23716
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
1191 (set-buffer-multibyte nil) |
212 | 1192 ;; delete the old data... |
1193 (let* ((data-start (+ start tar-header-offset -1)) | |
1194 (data-end (+ data-start (ash (ash (+ size 511) -9) 9)))) | |
1195 (delete-region data-start data-end) | |
1196 ;; insert the new data... | |
1197 (goto-char data-start) | |
1198 (insert-buffer subfile) | |
22181
dc8c3736ebea
(tar-mode): Position point on the name of the first file.
Richard M. Stallman <rms@gnu.org>
parents:
22032
diff
changeset
|
1199 (setq subfile-size |
dc8c3736ebea
(tar-mode): Position point on the name of the first file.
Richard M. Stallman <rms@gnu.org>
parents:
22032
diff
changeset
|
1200 (encode-coding-region |
dc8c3736ebea
(tar-mode): Position point on the name of the first file.
Richard M. Stallman <rms@gnu.org>
parents:
22032
diff
changeset
|
1201 data-start (+ data-start subfile-size) coding)) |
212 | 1202 ;; |
1203 ;; pad the new data out to a multiple of 512... | |
1204 (let ((subfile-size-pad (ash (ash (+ subfile-size 511) -9) 9))) | |
1205 (goto-char (+ data-start subfile-size)) | |
1206 (insert (make-string (- subfile-size-pad subfile-size) 0)) | |
1207 ;; | |
1208 ;; update the data pointer of this and all following files... | |
1209 (tar-setf (tar-header-size tokens) subfile-size) | |
1210 (let ((difference (- subfile-size-pad size-pad))) | |
1211 (tar-dolist (desc following-descs) | |
1212 (tar-setf (tar-desc-data-start desc) | |
1213 (+ (tar-desc-data-start desc) difference)))) | |
1214 ;; | |
1215 ;; Update the size field in the header block. | |
1216 (let ((header-start (- data-start 512))) | |
1217 (goto-char (+ header-start tar-size-offset)) | |
1218 (delete-region (point) (+ (point) 12)) | |
1219 (insert (format "%11o" subfile-size)) | |
1220 (insert ? ) | |
1221 ;; | |
1222 ;; Maybe update the datestamp. | |
1223 (if (not tar-update-datestamp) | |
1224 nil | |
1225 (goto-char (+ header-start tar-time-offset)) | |
1226 (delete-region (point) (+ (point) 12)) | |
880 | 1227 (insert (tar-octal-time (current-time))) |
212 | 1228 (insert ? )) |
1229 ;; | |
1230 ;; compute a new checksum and insert it. | |
8023
f29df49c6e53
(tar-extract): Set file name by hand before calling
Richard M. Stallman <rms@gnu.org>
parents:
7497
diff
changeset
|
1231 (let ((chk (tar-header-block-checksum |
212 | 1232 (buffer-substring header-start data-start)))) |
1233 (goto-char (+ header-start tar-chk-offset)) | |
1234 (delete-region (point) (+ (point) 8)) | |
1235 (insert (format "%6o" chk)) | |
1236 (insert 0) | |
1237 (insert ? ) | |
1238 (tar-setf (tar-header-checksum tokens) chk))) | |
1239 ;; | |
1240 ;; alter the descriptor-line... | |
1241 ;; | |
1242 (let ((position (- (length tar-parse-info) (length head)))) | |
1243 (goto-char 1) | |
1244 (next-line position) | |
1245 (beginning-of-line) | |
1246 (let ((p (point)) | |
7497
2308d6e6404c
(tar-extract): Put tar name into subfile visited name.
Richard M. Stallman <rms@gnu.org>
parents:
7464
diff
changeset
|
1247 after |
212 | 1248 (m (set-marker (make-marker) tar-header-offset))) |
1249 (forward-line 1) | |
7497
2308d6e6404c
(tar-extract): Put tar name into subfile visited name.
Richard M. Stallman <rms@gnu.org>
parents:
7464
diff
changeset
|
1250 (setq after (point)) |
2308d6e6404c
(tar-extract): Put tar name into subfile visited name.
Richard M. Stallman <rms@gnu.org>
parents:
7464
diff
changeset
|
1251 ;; Insert the new text after the old, before deleting, |
2308d6e6404c
(tar-extract): Put tar name into subfile visited name.
Richard M. Stallman <rms@gnu.org>
parents:
7464
diff
changeset
|
1252 ;; to preserve the window start. |
23716
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
1253 (let ((line (tar-header-block-summarize tokens t))) |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
1254 (if (multibyte-string-p line) |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
1255 (insert-before-markers (string-as-unibyte line) "\n") |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
1256 (insert-before-markers line "\n"))) |
7497
2308d6e6404c
(tar-extract): Put tar name into subfile visited name.
Richard M. Stallman <rms@gnu.org>
parents:
7464
diff
changeset
|
1257 (delete-region p after) |
212 | 1258 (setq tar-header-offset (marker-position m))) |
1259 ))) | |
1260 ;; after doing the insertion, add any final padding that may be necessary. | |
1261 (tar-pad-to-blocksize)) | |
23716
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
1262 (narrow-to-region 1 tar-header-offset) |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
1263 (set-buffer-multibyte tar-buffer-multibyte))) |
212 | 1264 (set-buffer-modified-p t) ; mark the tar file as modified |
22181
dc8c3736ebea
(tar-mode): Position point on the name of the first file.
Richard M. Stallman <rms@gnu.org>
parents:
22032
diff
changeset
|
1265 (tar-next-line 0) |
212 | 1266 (set-buffer subfile) |
23716
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
1267 ;; Restore the buffer multibyteness. |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
1268 (set-buffer-multibyte subfile-multibyte) |
212 | 1269 (set-buffer-modified-p nil) ; mark the tar subfile as unmodified |
11450
aee30032f324
(tar-mode): Locally bind next-line-add-newlines to nil.
Richard M. Stallman <rms@gnu.org>
parents:
11431
diff
changeset
|
1270 (message "Saved into tar-buffer `%s'. Be sure to save that buffer!" |
2542
ae4176e2e8fa
Add defvars to pacify the byte compiler, at RMS's request.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
880
diff
changeset
|
1271 (buffer-name tar-superior-buffer)) |
22181
dc8c3736ebea
(tar-mode): Position point on the name of the first file.
Richard M. Stallman <rms@gnu.org>
parents:
22032
diff
changeset
|
1272 ;; Prevent basic-save-buffer from changing our coding-system. |
dc8c3736ebea
(tar-mode): Position point on the name of the first file.
Richard M. Stallman <rms@gnu.org>
parents:
22032
diff
changeset
|
1273 (setq last-coding-system-used buffer-file-coding-system) |
4387
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
1274 ;; Prevent ordinary saving from happening. |
3e18f6a1915b
Fix doc strings and error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
4260
diff
changeset
|
1275 t))) |
212 | 1276 |
1277 | |
23716
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
1278 ;; When this function is called, it is sure that the buffer is unibyte. |
212 | 1279 (defun tar-pad-to-blocksize () |
1280 "If we are being anal about tar file blocksizes, fix up the current buffer. | |
1281 Leaves the region wide." | |
1282 (if (null tar-anal-blocksize) | |
1283 nil | |
1284 (widen) | |
1285 (let* ((last-desc (nth (1- (length tar-parse-info)) tar-parse-info)) | |
1286 (start (tar-desc-data-start last-desc)) | |
1287 (tokens (tar-desc-tokens last-desc)) | |
1288 (link-p (tar-header-link-type tokens)) | |
1289 (size (if link-p 0 (tar-header-size tokens))) | |
1290 (data-end (+ start size)) | |
1291 (bbytes (ash tar-anal-blocksize 9)) | |
1292 (pad-to (+ bbytes (* bbytes (/ (1- data-end) bbytes)))) | |
5821
4212fd8028bb
(tar-pad-to-blocksize): Bind inhibit-read-only, not buffer-read-only.
Richard M. Stallman <rms@gnu.org>
parents:
4586
diff
changeset
|
1293 (inhibit-read-only t) ; ## |
212 | 1294 ) |
1295 ;; If the padding after the last data is too long, delete some; | |
1296 ;; else insert some until we are padded out to the right number of blocks. | |
1297 ;; | |
1298 (goto-char (+ (or tar-header-offset 0) data-end)) | |
1299 (if (> (1+ (buffer-size)) (+ (or tar-header-offset 0) pad-to)) | |
1300 (delete-region (+ (or tar-header-offset 0) pad-to) (1+ (buffer-size))) | |
1301 (insert (make-string (- (+ (or tar-header-offset 0) pad-to) | |
1302 (1+ (buffer-size))) | |
1303 0))) | |
1304 ))) | |
1305 | |
1306 | |
6611
a5f180172ff3
Fix error message syntax.
Richard M. Stallman <rms@gnu.org>
parents:
5821
diff
changeset
|
1307 ;; Used in write-file-hook to write tar-files out correctly. |
11450
aee30032f324
(tar-mode): Locally bind next-line-add-newlines to nil.
Richard M. Stallman <rms@gnu.org>
parents:
11431
diff
changeset
|
1308 (defun tar-mode-write-file () |
aee30032f324
(tar-mode): Locally bind next-line-add-newlines to nil.
Richard M. Stallman <rms@gnu.org>
parents:
11431
diff
changeset
|
1309 (unwind-protect |
aee30032f324
(tar-mode): Locally bind next-line-add-newlines to nil.
Richard M. Stallman <rms@gnu.org>
parents:
11431
diff
changeset
|
1310 (save-excursion |
aee30032f324
(tar-mode): Locally bind next-line-add-newlines to nil.
Richard M. Stallman <rms@gnu.org>
parents:
11431
diff
changeset
|
1311 (widen) |
aee30032f324
(tar-mode): Locally bind next-line-add-newlines to nil.
Richard M. Stallman <rms@gnu.org>
parents:
11431
diff
changeset
|
1312 ;; Doing this here confuses things - the region gets left too wide! |
aee30032f324
(tar-mode): Locally bind next-line-add-newlines to nil.
Richard M. Stallman <rms@gnu.org>
parents:
11431
diff
changeset
|
1313 ;; I suppose this is run in a context where changing the buffer is bad. |
aee30032f324
(tar-mode): Locally bind next-line-add-newlines to nil.
Richard M. Stallman <rms@gnu.org>
parents:
11431
diff
changeset
|
1314 ;; (tar-pad-to-blocksize) |
21851
facde3a9a846
(tar-mode-write-file): Protect from null tar-header-offset.
Dave Love <fx@gnu.org>
parents:
21850
diff
changeset
|
1315 ;; tar-header-offset turns out to be null for files fetched with W3, |
facde3a9a846
(tar-mode-write-file): Protect from null tar-header-offset.
Dave Love <fx@gnu.org>
parents:
21850
diff
changeset
|
1316 ;; at least. |
23716
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
1317 (let ((coding-system-for-write 'no-conversion)) |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
1318 (write-region (or (byte-to-position tar-header-offset) |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
1319 (point-min)) |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
1320 (point-max) |
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
1321 buffer-file-name nil t)) |
15947
849a396187cd
(tar-mode-write-file): Clear buffer's own modified flag
Richard M. Stallman <rms@gnu.org>
parents:
15612
diff
changeset
|
1322 (tar-clear-modification-flags) |
849a396187cd
(tar-mode-write-file): Clear buffer's own modified flag
Richard M. Stallman <rms@gnu.org>
parents:
15612
diff
changeset
|
1323 (set-buffer-modified-p nil)) |
23716
d30ffa793626
(tar-header-block-tokenize): Decode codes of file
Kenichi Handa <handa@m17n.org>
parents:
23482
diff
changeset
|
1324 (narrow-to-region 1 (byte-to-position tar-header-offset))) |
11450
aee30032f324
(tar-mode): Locally bind next-line-add-newlines to nil.
Richard M. Stallman <rms@gnu.org>
parents:
11431
diff
changeset
|
1325 ;; return T because we've written the file. |
aee30032f324
(tar-mode): Locally bind next-line-add-newlines to nil.
Richard M. Stallman <rms@gnu.org>
parents:
11431
diff
changeset
|
1326 t) |
20970
00fce41bcd4f
Add "q" for quit, and use "C" for copy and "R" for
Karl Heuer <kwzh@gnu.org>
parents:
20808
diff
changeset
|
1327 |
00fce41bcd4f
Add "q" for quit, and use "C" for copy and "R" for
Karl Heuer <kwzh@gnu.org>
parents:
20808
diff
changeset
|
1328 (defun tar-quit () |
00fce41bcd4f
Add "q" for quit, and use "C" for copy and "R" for
Karl Heuer <kwzh@gnu.org>
parents:
20808
diff
changeset
|
1329 "Kill the current tar buffer." |
00fce41bcd4f
Add "q" for quit, and use "C" for copy and "R" for
Karl Heuer <kwzh@gnu.org>
parents:
20808
diff
changeset
|
1330 (interactive) |
00fce41bcd4f
Add "q" for quit, and use "C" for copy and "R" for
Karl Heuer <kwzh@gnu.org>
parents:
20808
diff
changeset
|
1331 (kill-buffer nil)) |
00fce41bcd4f
Add "q" for quit, and use "C" for copy and "R" for
Karl Heuer <kwzh@gnu.org>
parents:
20808
diff
changeset
|
1332 |
212 | 1333 |
1334 (provide 'tar-mode) | |
1335 | |
658
7cbd4fcd8b0f
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
584
diff
changeset
|
1336 ;;; tar-mode.el ends here |