Mercurial > emacs
annotate lisp/arc-mode.el @ 110410:f2e111723c3a
Merge changes made in Gnus trunk.
Reimplement nnimap, and do tweaks to the rest of the code to support that.
* gnus-int.el (gnus-finish-retrieve-group-infos)
(gnus-retrieve-group-data-early): New functions.
* gnus-range.el (gnus-range-nconcat): New function.
* gnus-start.el (gnus-get-unread-articles): Support early retrieval of
data.
(gnus-read-active-for-groups): Support finishing the early retrieval of
data.
* gnus-sum.el (gnus-summary-move-article): Pass the move-to group name
if the move is internal, so that nnimap can do fast internal moves.
* gnus.el (gnus-article-special-mark-lists): Add uid/active tuples, for
nnimap usage.
* nnimap.el: Rewritten.
* nnmail.el (nnmail-inhibit-default-split-group): New internal variable
to allow the mail splitting to not return a default group. This is
useful for nnimap, which will leave unmatched mail in the inbox.
* utf7.el (utf7-encode): Autoload.
Implement shell connection.
* nnimap.el (nnimap-open-shell-stream): New function.
(nnimap-open-connection): Use it.
Get the number of lines by using BODYSTRUCTURE.
(nnimap-transform-headers): Get the number of lines in each message.
(nnimap-retrieve-headers): Query for BODYSTRUCTURE so that we get the
number of lines.
Not all servers return UIDNEXT. Work past this problem.
Remove junk from end of file.
Fix typo in "bogus" section.
Make capabilties be case-insensitive.
Require cl when compiling.
Don't bug out if the LIST command doesn't have any parameters.
2010-09-17 Knut Anders Hatlen <kahatlen@gmail.com> (tiny change)
* nnimap.el (nnimap-get-groups): Don't bug out if the LIST command
doesn't have any parameters.
(mm-text-html-renderer): Document gnus-article-html.
2010-09-17 Julien Danjou <julien@danjou.info> (tiny fix)
* mm-decode.el (mm-text-html-renderer): Document gnus-article-html.
* dgnushack.el: Define netrc-credentials.
If the user doesn't have a /etc/services, supply some sensible port defaults.
Have `unseen-or-unread' select an unread unseen article first.
(nntp-open-server): Return whether the open was successful or not.
Throughout all files, replace (save-excursion (set-buffer ...)) with (with-current-buffer ... ).
Save result so that it doesn't say "failed" all the time.
Add ~/.authinfo to the default, since that's probably most useful for users.
Don't use the "finish" method when we're reading from the agent.
Add some more nnimap-relevant agent stuff to nnagent.el.
* nnimap.el (nnimap-with-process-buffer): Removed.
Revert one line that was changed by mistake in the last checkin.
(nnimap-open-connection): Don't error out when we can't make a connection
nnimap-related changes to avoid bugging out if we can't contact a server.
* gnus-start.el (gnus-get-unread-articles): Don't try to scan groups
from methods that are denied.
* nnimap.el (nnimap-possibly-change-group): Return nil if we can't log
in.
(nnimap-finish-retrieve-group-infos): Make sure we're not waiting for
nothing.
* gnus-sum.el (gnus-select-newsgroup): Indent.
author | Katsumi Yamaoka <yamaoka@jpl.org> |
---|---|
date | Sat, 18 Sep 2010 10:02:19 +0000 |
parents | 60516122d066 |
children | 249a1455856a |
rev | line source |
---|---|
11880 | 1 ;;; arc-mode.el --- simple editing of archives |
2 | |
104823
68150c643e2e
Use default-value rather than default-enable-multibyte-characters.
Glenn Morris <rgm@gnu.org>
parents:
104684
diff
changeset
|
3 ;; Copyright (C) 1995, 1997, 1998, 2001, 2002, 2003, 2004, 2005, 2006, |
106815 | 4 ;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc. |
11880 | 5 |
53397
2843dc1a9a6f
Update author email addr.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
6 ;; Author: Morten Welinder <terra@gnu.org> |
106259
feb88a2b5aea
* arc-mode.el: Add "Keywords: files", so the details in its
Kevin Ryde <user42@zip.com.au>
parents:
106026
diff
changeset
|
7 ;; Keywords: files archives msdog editing major-mode |
11880 | 8 ;; Favourite-brand-of-beer: None, I hate beer. |
9 | |
14169 | 10 ;; This file is part of GNU Emacs. |
11 | |
94678
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93613
diff
changeset
|
12 ;; GNU Emacs is free software: you can redistribute it and/or modify |
14169 | 13 ;; it under the terms of the GNU General Public License as published by |
94678
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93613
diff
changeset
|
14 ;; the Free Software Foundation, either version 3 of the License, or |
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93613
diff
changeset
|
15 ;; (at your option) any later version. |
14169 | 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 | |
94678
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93613
diff
changeset
|
23 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
11880 | 24 |
25 ;;; Commentary: | |
14169 | 26 |
11880 | 27 ;; NAMING: "arc" is short for "archive" and does not refer specifically |
28 ;; to files whose name end in ".arc" | |
29 ;; | |
30 ;; This code does not decode any files internally, although it does | |
31 ;; understand the directory level of the archives. For this reason, | |
32 ;; you should expect this code to need more fiddling than tar-mode.el | |
33 ;; (although it at present has fewer bugs :-) In particular, I have | |
34 ;; not tested this under Ms-Dog myself. | |
35 ;; ------------------------------------- | |
36 ;; INTERACTION: arc-mode.el should play together with | |
37 ;; | |
38 ;; * ange-ftp.el: Remote archives (i.e., ones that ange-ftp has brought | |
39 ;; to you) are handled by doing all updates on a local | |
40 ;; copy. When you make changes to a remote file the | |
41 ;; changes will first take effect when the archive buffer | |
42 ;; is saved. You will be warned about this. | |
43 ;; | |
44 ;; * dos-fns.el: (Part of Emacs 19). You get automatic ^M^J <--> ^J | |
45 ;; conversion. | |
46 ;; | |
47 ;; arc-mode.el does not work well with crypt++.el; for the archives as | |
48 ;; such this could be fixed (but wouldn't be useful) by declaring such | |
49 ;; archives to be "remote". For the members this is a general Emacs | |
50 ;; problem that 19.29's file formats may fix. | |
51 ;; ------------------------------------- | |
52 ;; ARCHIVE TYPES: Currently only the archives below are handled, but the | |
53 ;; structure for handling just about anything is in place. | |
54 ;; | |
107896
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
55 ;; Arc Lzh Zip Zoo Rar 7z |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
56 ;; -------------------------------------------- |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
57 ;; View listing Intern Intern Intern Intern Y Y |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
58 ;; Extract member Y Y Y Y Y Y |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
59 ;; Save changed member Y Y Y Y N N |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
60 ;; Add new member N N N N N N |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
61 ;; Delete member Y Y Y Y N N |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
62 ;; Rename member Y Y N N N N |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
63 ;; Chmod - Y Y - N N |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
64 ;; Chown - Y - - N N |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
65 ;; Chgrp - Y - - N N |
11880 | 66 ;; |
67 ;; Special thanks to Bill Brodie <wbrodie@panix.com> for very useful tips | |
68 ;; on the first released version of this package. | |
69 ;; | |
70 ;; This code is partly based on tar-mode.el from Emacs. | |
71 ;; ------------------------------------- | |
72 ;; ARCHIVE STRUCTURES: | |
73 ;; (This is mostly for myself.) | |
74 ;; | |
75 ;; ARC A series of (header,file). No interactions among members. | |
76 ;; | |
77 ;; LZH A series of (header,file). Headers are checksummed. No | |
78 ;; interaction among members. | |
49437
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
79 ;; Headers come in three flavours called level 0, 1 and 2 headers. |
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
80 ;; Level 2 header is free of DOS specific restrictions and most |
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
81 ;; prevalently used. Also level 1 and 2 headers consist of base |
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
82 ;; and extension headers. For more details see |
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
83 ;; http://homepage1.nifty.com/dangan/en/Content/Program/Java/jLHA/Notes/Notes.html |
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
84 ;; http://www.osirusoft.com/joejared/lzhformat.html |
11880 | 85 ;; |
86 ;; ZIP A series of (lheader,fil) followed by a "central directory" | |
87 ;; which is a series of (cheader) followed by an end-of- | |
88 ;; central-dir record possibly followed by junk. The e-o-c-d | |
89 ;; links to c-d. cheaders link to lheaders which are basically | |
90 ;; cut-down versions of the cheaders. | |
91 ;; | |
92 ;; ZOO An archive header followed by a series of (header,file). | |
93 ;; Each member header points to the next. The archive is | |
94 ;; terminated by a bogus header with a zero next link. | |
95 ;; ------------------------------------- | |
42704 | 96 ;; HOOKS: `foo' means one of the supported archive types. |
11880 | 97 ;; |
98 ;; archive-mode-hook | |
99 ;; archive-foo-mode-hook | |
100 ;; archive-extract-hooks | |
101 | |
102 ;;; Code: | |
103 | |
104 ;; ------------------------------------------------------------------------- | |
84661
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
105 ;;; Section: Configuration. |
11880 | 106 |
19926 | 107 (defgroup archive nil |
108 "Simple editing of archives." | |
109 :group 'data) | |
110 | |
111 (defgroup archive-arc nil | |
112 "ARC-specific options to archive." | |
113 :group 'archive) | |
114 | |
115 (defgroup archive-lzh nil | |
116 "LZH-specific options to archive." | |
117 :group 'archive) | |
11880 | 118 |
19926 | 119 (defgroup archive-zip nil |
120 "ZIP-specific options to archive." | |
121 :group 'archive) | |
122 | |
123 (defgroup archive-zoo nil | |
124 "ZOO-specific options to archive." | |
125 :group 'archive) | |
126 | |
127 (defcustom archive-tmpdir | |
43679 | 128 ;; make-temp-name is safe here because we use this name |
129 ;; to create a directory. | |
22062
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
130 (make-temp-name |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
131 (expand-file-name (if (eq system-type 'ms-dos) "ar" "archive.tmp") |
22096
2f9cb89376a6
(archive-tmpdir): Use temporary-file-directory.
Richard M. Stallman <rms@gnu.org>
parents:
22086
diff
changeset
|
132 temporary-file-directory)) |
64528
54d2ccd509bc
(archive-get-descr, archive-alternate-display): Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
64091
diff
changeset
|
133 "Directory for temporary files made by `arc-mode.el'." |
19926 | 134 :type 'directory |
135 :group 'archive) | |
11880 | 136 |
19926 | 137 (defcustom archive-remote-regexp "^/[^/:]*[^/:.]:" |
100171 | 138 "Regexp recognizing archive files names that are not local. |
12791
61bbb487bf2c
Standardize layout of doc strings.
Richard M. Stallman <rms@gnu.org>
parents:
12756
diff
changeset
|
139 A non-local file is one whose file name is not proper outside Emacs. |
19926 | 140 A local copy of the archive will be used when updating." |
141 :type 'regexp | |
142 :group 'archive) | |
11880 | 143 |
19926 | 144 (defcustom archive-extract-hooks nil |
100171 | 145 "Hooks to run when an archive member has been extracted." |
19926 | 146 :type 'hook |
147 :group 'archive) | |
11880 | 148 ;; ------------------------------ |
149 ;; Arc archive configuration | |
150 | |
151 ;; We always go via a local file since there seems to be no reliable way | |
152 ;; to extract to stdout without junk getting added. | |
19926 | 153 (defcustom archive-arc-extract |
11880 | 154 '("arc" "x") |
100171 | 155 "Program and its options to run in order to extract an arc file member. |
12791
61bbb487bf2c
Standardize layout of doc strings.
Richard M. Stallman <rms@gnu.org>
parents:
12756
diff
changeset
|
156 Extraction should happen to the current directory. Archive and member |
19926 | 157 name will be added." |
158 :type '(list (string :tag "Program") | |
159 (repeat :tag "Options" | |
160 :inline t | |
161 (string :format "%v"))) | |
162 :group 'archive-arc) | |
11880 | 163 |
19926 | 164 (defcustom archive-arc-expunge |
11880 | 165 '("arc" "d") |
100171 | 166 "Program and its options to run in order to delete arc file members. |
19926 | 167 Archive and member names will be added." |
168 :type '(list (string :tag "Program") | |
169 (repeat :tag "Options" | |
170 :inline t | |
171 (string :format "%v"))) | |
172 :group 'archive-arc) | |
11880 | 173 |
19926 | 174 (defcustom archive-arc-write-file-member |
11880 | 175 '("arc" "u") |
100171 | 176 "Program and its options to run in order to update an arc file member. |
19926 | 177 Archive and member name will be added." |
178 :type '(list (string :tag "Program") | |
179 (repeat :tag "Options" | |
180 :inline t | |
181 (string :format "%v"))) | |
182 :group 'archive-arc) | |
11880 | 183 ;; ------------------------------ |
184 ;; Lzh archive configuration | |
185 | |
19926 | 186 (defcustom archive-lzh-extract |
11880 | 187 '("lha" "pq") |
100171 | 188 "Program and its options to run in order to extract an lzh file member. |
12791
61bbb487bf2c
Standardize layout of doc strings.
Richard M. Stallman <rms@gnu.org>
parents:
12756
diff
changeset
|
189 Extraction should happen to standard output. Archive and member name will |
19926 | 190 be added." |
191 :type '(list (string :tag "Program") | |
192 (repeat :tag "Options" | |
193 :inline t | |
194 (string :format "%v"))) | |
195 :group 'archive-lzh) | |
11880 | 196 |
19926 | 197 (defcustom archive-lzh-expunge |
11880 | 198 '("lha" "d") |
100171 | 199 "Program and its options to run in order to delete lzh file members. |
19926 | 200 Archive and member names will be added." |
201 :type '(list (string :tag "Program") | |
202 (repeat :tag "Options" | |
203 :inline t | |
204 (string :format "%v"))) | |
205 :group 'archive-lzh) | |
11880 | 206 |
19926 | 207 (defcustom archive-lzh-write-file-member |
11880 | 208 '("lha" "a") |
100171 | 209 "Program and its options to run in order to update an lzh file member. |
19926 | 210 Archive and member name will be added." |
211 :type '(list (string :tag "Program") | |
212 (repeat :tag "Options" | |
213 :inline t | |
214 (string :format "%v"))) | |
215 :group 'archive-lzh) | |
11880 | 216 ;; ------------------------------ |
217 ;; Zip archive configuration | |
218 | |
19926 | 219 (defcustom archive-zip-extract |
107896
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
220 (cond ((executable-find "unzip") '("unzip" "-qq" "-c")) |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
221 ((executable-find "7z") '("7z" "x" "-so")) |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
222 ((executable-find "pkunzip") '("pkunzip" "-e" "-o-")) |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
223 (t '("unzip" "-qq" "-c"))) |
100171 | 224 "Program and its options to run in order to extract a zip file member. |
12791
61bbb487bf2c
Standardize layout of doc strings.
Richard M. Stallman <rms@gnu.org>
parents:
12756
diff
changeset
|
225 Extraction should happen to standard output. Archive and member name will |
66124
d2f6c64a5b45
(archive-zip-extract): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
64762
diff
changeset
|
226 be added." |
19926 | 227 :type '(list (string :tag "Program") |
107896
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
228 (repeat :tag "Options" |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
229 :inline t |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
230 (string :format "%v"))) |
19926 | 231 :group 'archive-zip) |
11880 | 232 |
96376
c3309dba6542
American English spelling fix.
Glenn Morris <rgm@gnu.org>
parents:
96360
diff
changeset
|
233 ;; For several reasons the latter behavior is not desirable in general. |
11880 | 234 ;; (1) It uses more disk space. (2) Error checking is worse or non- |
235 ;; existent. (3) It tends to do funny things with other systems' file | |
236 ;; names. | |
237 | |
19926 | 238 (defcustom archive-zip-expunge |
63889
abe14daaa679
Bind inhibit-read-only rather than buffer-read-only.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
62714
diff
changeset
|
239 (if (and (not (executable-find "zip")) |
abe14daaa679
Bind inhibit-read-only rather than buffer-read-only.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
62714
diff
changeset
|
240 (executable-find "pkzip")) |
abe14daaa679
Bind inhibit-read-only rather than buffer-read-only.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
62714
diff
changeset
|
241 '("pkzip" "-d") |
abe14daaa679
Bind inhibit-read-only rather than buffer-read-only.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
62714
diff
changeset
|
242 '("zip" "-d" "-q")) |
100171 | 243 "Program and its options to run in order to delete zip file members. |
19926 | 244 Archive and member names will be added." |
245 :type '(list (string :tag "Program") | |
246 (repeat :tag "Options" | |
247 :inline t | |
248 (string :format "%v"))) | |
249 :group 'archive-zip) | |
11880 | 250 |
19926 | 251 (defcustom archive-zip-update |
63889
abe14daaa679
Bind inhibit-read-only rather than buffer-read-only.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
62714
diff
changeset
|
252 (if (and (not (executable-find "zip")) |
abe14daaa679
Bind inhibit-read-only rather than buffer-read-only.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
62714
diff
changeset
|
253 (executable-find "pkzip")) |
abe14daaa679
Bind inhibit-read-only rather than buffer-read-only.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
62714
diff
changeset
|
254 '("pkzip" "-u" "-P") |
abe14daaa679
Bind inhibit-read-only rather than buffer-read-only.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
62714
diff
changeset
|
255 '("zip" "-q")) |
100171 | 256 "Program and its options to run in order to update a zip file member. |
11880 | 257 Options should ensure that specified directory will be put into the zip |
19926 | 258 file. Archive and member name will be added." |
259 :type '(list (string :tag "Program") | |
260 (repeat :tag "Options" | |
261 :inline t | |
262 (string :format "%v"))) | |
263 :group 'archive-zip) | |
11880 | 264 |
19926 | 265 (defcustom archive-zip-update-case |
63889
abe14daaa679
Bind inhibit-read-only rather than buffer-read-only.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
62714
diff
changeset
|
266 (if (and (not (executable-find "zip")) |
abe14daaa679
Bind inhibit-read-only rather than buffer-read-only.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
62714
diff
changeset
|
267 (executable-find "pkzip")) |
abe14daaa679
Bind inhibit-read-only rather than buffer-read-only.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
62714
diff
changeset
|
268 '("pkzip" "-u" "-P") |
abe14daaa679
Bind inhibit-read-only rather than buffer-read-only.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
62714
diff
changeset
|
269 '("zip" "-q" "-k")) |
100171 | 270 "Program and its options to run in order to update a case fiddled zip member. |
12791
61bbb487bf2c
Standardize layout of doc strings.
Richard M. Stallman <rms@gnu.org>
parents:
12756
diff
changeset
|
271 Options should ensure that specified directory will be put into the zip file. |
19926 | 272 Archive and member name will be added." |
273 :type '(list (string :tag "Program") | |
274 (repeat :tag "Options" | |
275 :inline t | |
276 (string :format "%v"))) | |
277 :group 'archive-zip) | |
11880 | 278 |
19926 | 279 (defcustom archive-zip-case-fiddle t |
100171 | 280 "If non-nil then zip file members may be down-cased. |
22062
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
281 This case fiddling will only happen for members created by a system |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
282 that uses caseless file names." |
19926 | 283 :type 'boolean |
284 :group 'archive-zip) | |
11880 | 285 ;; ------------------------------ |
286 ;; Zoo archive configuration | |
287 | |
19926 | 288 (defcustom archive-zoo-extract |
11880 | 289 '("zoo" "xpq") |
100171 | 290 "Program and its options to run in order to extract a zoo file member. |
12791
61bbb487bf2c
Standardize layout of doc strings.
Richard M. Stallman <rms@gnu.org>
parents:
12756
diff
changeset
|
291 Extraction should happen to standard output. Archive and member name will |
19926 | 292 be added." |
293 :type '(list (string :tag "Program") | |
294 (repeat :tag "Options" | |
295 :inline t | |
296 (string :format "%v"))) | |
297 :group 'archive-zoo) | |
11880 | 298 |
19926 | 299 (defcustom archive-zoo-expunge |
11880 | 300 '("zoo" "DqPP") |
100171 | 301 "Program and its options to run in order to delete zoo file members. |
19926 | 302 Archive and member names will be added." |
303 :type '(list (string :tag "Program") | |
304 (repeat :tag "Options" | |
305 :inline t | |
306 (string :format "%v"))) | |
307 :group 'archive-zoo) | |
11880 | 308 |
19926 | 309 (defcustom archive-zoo-write-file-member |
11880 | 310 '("zoo" "a") |
100171 | 311 "Program and its options to run in order to update a zoo file member. |
19926 | 312 Archive and member name will be added." |
313 :type '(list (string :tag "Program") | |
314 (repeat :tag "Options" | |
315 :inline t | |
316 (string :format "%v"))) | |
317 :group 'archive-zoo) | |
107896
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
318 ;; ------------------------------ |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
319 ;; 7z archive configuration |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
320 |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
321 (defcustom archive-7z-extract |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
322 '("7z" "x" "-so") |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
323 "Program and its options to run in order to extract a 7z file member. |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
324 Extraction should happen to standard output. Archive and member name will |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
325 be added." |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
326 :type '(list (string :tag "Program") |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
327 (repeat :tag "Options" |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
328 :inline t |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
329 (string :format "%v"))) |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
330 :group 'archive-7z) |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
331 |
11880 | 332 ;; ------------------------------------------------------------------------- |
84661
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
333 ;;; Section: Variables |
11880 | 334 |
50136
ad28e7a35442
* files.el (recover-session): Error if there are no previous
John Paul Wallington <jpw@pobox.com>
parents:
49588
diff
changeset
|
335 (defvar archive-subtype nil "Symbol describing archive type.") |
ad28e7a35442
* files.el (recover-session): Error if there are no previous
John Paul Wallington <jpw@pobox.com>
parents:
49588
diff
changeset
|
336 (defvar archive-file-list-start nil "Position of first contents line.") |
ad28e7a35442
* files.el (recover-session): Error if there are no previous
John Paul Wallington <jpw@pobox.com>
parents:
49588
diff
changeset
|
337 (defvar archive-file-list-end nil "Position just after last contents line.") |
ad28e7a35442
* files.el (recover-session): Error if there are no previous
John Paul Wallington <jpw@pobox.com>
parents:
49588
diff
changeset
|
338 (defvar archive-proper-file-start nil "Position of real archive's start.") |
ad28e7a35442
* files.el (recover-session): Error if there are no previous
John Paul Wallington <jpw@pobox.com>
parents:
49588
diff
changeset
|
339 (defvar archive-read-only nil "Non-nil if the archive is read-only on disk.") |
ad28e7a35442
* files.el (recover-session): Error if there are no previous
John Paul Wallington <jpw@pobox.com>
parents:
49588
diff
changeset
|
340 (defvar archive-local-name nil "Name of local copy of remote archive.") |
61414
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
341 (defvar archive-mode-map |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
342 (let ((map (make-keymap))) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
343 (suppress-keymap map) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
344 (define-key map " " 'archive-next-line) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
345 (define-key map "a" 'archive-alternate-display) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
346 ;;(define-key map "c" 'archive-copy) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
347 (define-key map "d" 'archive-flag-deleted) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
348 (define-key map "\C-d" 'archive-flag-deleted) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
349 (define-key map "e" 'archive-extract) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
350 (define-key map "f" 'archive-extract) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
351 (define-key map "\C-m" 'archive-extract) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
352 (define-key map "g" 'revert-buffer) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
353 (define-key map "h" 'describe-mode) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
354 (define-key map "m" 'archive-mark) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
355 (define-key map "n" 'archive-next-line) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
356 (define-key map "\C-n" 'archive-next-line) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
357 (define-key map [down] 'archive-next-line) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
358 (define-key map "o" 'archive-extract-other-window) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
359 (define-key map "p" 'archive-previous-line) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
360 (define-key map "q" 'quit-window) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
361 (define-key map "\C-p" 'archive-previous-line) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
362 (define-key map [up] 'archive-previous-line) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
363 (define-key map "r" 'archive-rename-entry) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
364 (define-key map "u" 'archive-unflag) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
365 (define-key map "\M-\C-?" 'archive-unmark-all-files) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
366 (define-key map "v" 'archive-view) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
367 (define-key map "x" 'archive-expunge) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
368 (define-key map "\177" 'archive-unflag-backwards) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
369 (define-key map "E" 'archive-extract-other-window) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
370 (define-key map "M" 'archive-chmod-entry) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
371 (define-key map "G" 'archive-chgrp-entry) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
372 (define-key map "O" 'archive-chown-entry) |
93613
1cee153604e6
(archive-mode-map): Obey mouse-1-click-follows-link.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92538
diff
changeset
|
373 ;; Let mouse-1 follow the link. |
1cee153604e6
(archive-mode-map): Obey mouse-1-click-follows-link.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92538
diff
changeset
|
374 (define-key map [follow-link] 'mouse-face) |
61414
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
375 |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
376 (if (fboundp 'command-remapping) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
377 (progn |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
378 (define-key map [remap advertised-undo] 'archive-undo) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
379 (define-key map [remap undo] 'archive-undo)) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
380 (substitute-key-definition 'advertised-undo 'archive-undo map global-map) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
381 (substitute-key-definition 'undo 'archive-undo map global-map)) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
382 |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
383 (define-key map |
63891
d7d21c20c225
(archive-extract): Make it work as a mouse binding.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
63889
diff
changeset
|
384 (if (featurep 'xemacs) 'button2 [mouse-2]) 'archive-extract) |
61414
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
385 |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
386 (if (featurep 'xemacs) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
387 () ; out of luck |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
388 |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
389 (define-key map [menu-bar immediate] |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
390 (cons "Immediate" (make-sparse-keymap "Immediate"))) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
391 (define-key map [menu-bar immediate alternate] |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
392 '(menu-item "Alternate Display" archive-alternate-display |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
393 :enable (boundp (archive-name "alternate-display")) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
394 :help "Toggle alternate file info display")) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
395 (define-key map [menu-bar immediate view] |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
396 '(menu-item "View This File" archive-view |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
397 :help "Display file at cursor in View Mode")) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
398 (define-key map [menu-bar immediate display] |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
399 '(menu-item "Display in Other Window" archive-display-other-window |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
400 :help "Display file at cursor in another window")) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
401 (define-key map [menu-bar immediate find-file-other-window] |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
402 '(menu-item "Find in Other Window" archive-extract-other-window |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
403 :help "Edit file at cursor in another window")) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
404 (define-key map [menu-bar immediate find-file] |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
405 '(menu-item "Find This File" archive-extract |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
406 :help "Extract file at cursor and edit it")) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
407 |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
408 (define-key map [menu-bar mark] |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
409 (cons "Mark" (make-sparse-keymap "Mark"))) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
410 (define-key map [menu-bar mark unmark-all] |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
411 '(menu-item "Unmark All" archive-unmark-all-files |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
412 :help "Unmark all marked files")) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
413 (define-key map [menu-bar mark deletion] |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
414 '(menu-item "Flag" archive-flag-deleted |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
415 :help "Flag file at cursor for deletion")) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
416 (define-key map [menu-bar mark unmark] |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
417 '(menu-item "Unflag" archive-unflag |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
418 :help "Unmark file at cursor")) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
419 (define-key map [menu-bar mark mark] |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
420 '(menu-item "Mark" archive-mark |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
421 :help "Mark file at cursor")) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
422 |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
423 (define-key map [menu-bar operate] |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
424 (cons "Operate" (make-sparse-keymap "Operate"))) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
425 (define-key map [menu-bar operate chown] |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
426 '(menu-item "Change Owner..." archive-chown-entry |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
427 :enable (fboundp (archive-name "chown-entry")) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
428 :help "Change owner of marked files")) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
429 (define-key map [menu-bar operate chgrp] |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
430 '(menu-item "Change Group..." archive-chgrp-entry |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
431 :enable (fboundp (archive-name "chgrp-entry")) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
432 :help "Change group ownership of marked files")) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
433 (define-key map [menu-bar operate chmod] |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
434 '(menu-item "Change Mode..." archive-chmod-entry |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
435 :enable (fboundp (archive-name "chmod-entry")) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
436 :help "Change mode (permissions) of marked files")) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
437 (define-key map [menu-bar operate rename] |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
438 '(menu-item "Rename to..." archive-rename-entry |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
439 :enable (fboundp (archive-name "rename-entry")) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
440 :help "Rename marked files")) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
441 ;;(define-key map [menu-bar operate copy] |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
442 ;; '(menu-item "Copy to..." archive-copy)) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
443 (define-key map [menu-bar operate expunge] |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
444 '(menu-item "Expunge Marked Files" archive-expunge |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
445 :help "Delete all flagged files from archive")) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
446 map)) |
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
447 "Local keymap for archive mode listings.") |
50136
ad28e7a35442
* files.el (recover-session): Error if there are no previous
John Paul Wallington <jpw@pobox.com>
parents:
49588
diff
changeset
|
448 (defvar archive-file-name-indent nil "Column where file names start.") |
11880 | 449 |
50136
ad28e7a35442
* files.el (recover-session): Error if there are no previous
John Paul Wallington <jpw@pobox.com>
parents:
49588
diff
changeset
|
450 (defvar archive-remote nil "Non-nil if the archive is outside file system.") |
22062
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
451 (make-variable-buffer-local 'archive-remote) |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
452 (put 'archive-remote 'permanent-local t) |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
453 |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
454 (defvar archive-member-coding-system nil "Coding-system of archive member.") |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
455 (make-variable-buffer-local 'archive-member-coding-system) |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
456 |
11880 | 457 (defvar archive-alternate-display nil |
50136
ad28e7a35442
* files.el (recover-session): Error if there are no previous
John Paul Wallington <jpw@pobox.com>
parents:
49588
diff
changeset
|
458 "Non-nil when alternate information is shown.") |
11880 | 459 (make-variable-buffer-local 'archive-alternate-display) |
460 (put 'archive-alternate-display 'permanent-local t) | |
461 | |
50136
ad28e7a35442
* files.el (recover-session): Error if there are no previous
John Paul Wallington <jpw@pobox.com>
parents:
49588
diff
changeset
|
462 (defvar archive-superior-buffer nil "In archive members, points to archive.") |
11880 | 463 (put 'archive-superior-buffer 'permanent-local t) |
464 | |
50136
ad28e7a35442
* files.el (recover-session): Error if there are no previous
John Paul Wallington <jpw@pobox.com>
parents:
49588
diff
changeset
|
465 (defvar archive-subfile-mode nil "Non-nil in archive member buffers.") |
11880 | 466 (make-variable-buffer-local 'archive-subfile-mode) |
467 (put 'archive-subfile-mode 'permanent-local t) | |
468 | |
88954
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
469 (defvar archive-file-name-coding-system nil) |
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
470 (make-variable-buffer-local 'archive-file-name-coding-system) |
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
471 (put 'archive-file-name-coding-system 'permanent-local t) |
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
472 |
16291 | 473 (defvar archive-files nil |
474 "Vector of file descriptors. | |
475 Each descriptor is a vector of the form | |
476 [EXT-FILE-NAME INT-FILE-NAME CASE-FIDDLED MODE ...]") | |
11880 | 477 (make-variable-buffer-local 'archive-files) |
12024
8e31a35ac027
(archive-lemacs): New variable.
Karl Heuer <kwzh@gnu.org>
parents:
11887
diff
changeset
|
478 |
11880 | 479 ;; ------------------------------------------------------------------------- |
84661
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
480 ;;; Section: Support functions. |
11880 | 481 |
88954
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
482 (eval-when-compile |
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
483 (defsubst byte-after (pos) |
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
484 "Like char-after but an eight-bit char is converted to unibyte." |
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
485 (multibyte-char-to-unibyte (char-after pos))) |
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
486 (defsubst insert-unibyte (&rest args) |
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
487 "Like insert but don't make unibyte string and eight-bit char multibyte." |
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
488 (dolist (elt args) |
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
489 (if (integerp elt) |
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
490 (insert (if (< elt 128) elt (decode-char 'eight-bit elt))) |
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
491 (insert (string-to-multibyte elt))))) |
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
492 ) |
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
493 |
11880 | 494 (defsubst archive-name (suffix) |
495 (intern (concat "archive-" (symbol-name archive-subtype) "-" suffix))) | |
496 | |
70388
000b130bfb7d
(archive-l-e): New optional argument `float' means generate a float value.
Eli Zaretskii <eliz@gnu.org>
parents:
69331
diff
changeset
|
497 (defun archive-l-e (str &optional len float) |
64528
54d2ccd509bc
(archive-get-descr, archive-alternate-display): Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
64091
diff
changeset
|
498 "Convert little endian string/vector STR to integer. |
54d2ccd509bc
(archive-get-descr, archive-alternate-display): Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
64091
diff
changeset
|
499 Alternatively, STR may be a buffer position in the current buffer |
70388
000b130bfb7d
(archive-l-e): New optional argument `float' means generate a float value.
Eli Zaretskii <eliz@gnu.org>
parents:
69331
diff
changeset
|
500 in which case a second argument, length LEN, should be supplied. |
000b130bfb7d
(archive-l-e): New optional argument `float' means generate a float value.
Eli Zaretskii <eliz@gnu.org>
parents:
69331
diff
changeset
|
501 FLOAT, if non-nil, means generate and return a float instead of an integer |
000b130bfb7d
(archive-l-e): New optional argument `float' means generate a float value.
Eli Zaretskii <eliz@gnu.org>
parents:
69331
diff
changeset
|
502 \(use this for numbers that can overflow the Emacs integer)." |
11880 | 503 (if (stringp str) |
504 (setq len (length str)) | |
505 (setq str (buffer-substring str (+ str len)))) | |
89483 | 506 (setq str (string-as-unibyte str)) |
11880 | 507 (let ((result 0) |
508 (i 0)) | |
509 (while (< i len) | |
510 (setq i (1+ i) | |
70388
000b130bfb7d
(archive-l-e): New optional argument `float' means generate a float value.
Eli Zaretskii <eliz@gnu.org>
parents:
69331
diff
changeset
|
511 result (+ (if float (* result 256.0) (ash result 8)) |
000b130bfb7d
(archive-l-e): New optional argument `float' means generate a float value.
Eli Zaretskii <eliz@gnu.org>
parents:
69331
diff
changeset
|
512 (aref str (- len i))))) |
11880 | 513 result)) |
514 | |
515 (defun archive-int-to-mode (mode) | |
37645
3fa9dd549e89
(archive-int-to-mode): Construct the string directly.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
32484
diff
changeset
|
516 "Turn an integer like 0700 (i.e., 448) into a mode string like -rwx------." |
3fa9dd549e89
(archive-int-to-mode): Construct the string directly.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
32484
diff
changeset
|
517 ;; FIXME: merge with tar-grind-file-mode. |
3fa9dd549e89
(archive-int-to-mode): Construct the string directly.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
32484
diff
changeset
|
518 (string |
3fa9dd549e89
(archive-int-to-mode): Construct the string directly.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
32484
diff
changeset
|
519 (if (zerop (logand 8192 mode)) |
3fa9dd549e89
(archive-int-to-mode): Construct the string directly.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
32484
diff
changeset
|
520 (if (zerop (logand 16384 mode)) ?- ?d) |
3fa9dd549e89
(archive-int-to-mode): Construct the string directly.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
32484
diff
changeset
|
521 ?c) ; completeness |
3fa9dd549e89
(archive-int-to-mode): Construct the string directly.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
32484
diff
changeset
|
522 (if (zerop (logand 256 mode)) ?- ?r) |
3fa9dd549e89
(archive-int-to-mode): Construct the string directly.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
32484
diff
changeset
|
523 (if (zerop (logand 128 mode)) ?- ?w) |
3fa9dd549e89
(archive-int-to-mode): Construct the string directly.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
32484
diff
changeset
|
524 (if (zerop (logand 64 mode)) |
3fa9dd549e89
(archive-int-to-mode): Construct the string directly.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
32484
diff
changeset
|
525 (if (zerop (logand 1024 mode)) ?- ?S) |
3fa9dd549e89
(archive-int-to-mode): Construct the string directly.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
32484
diff
changeset
|
526 (if (zerop (logand 1024 mode)) ?x ?s)) |
3fa9dd549e89
(archive-int-to-mode): Construct the string directly.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
32484
diff
changeset
|
527 (if (zerop (logand 32 mode)) ?- ?r) |
3fa9dd549e89
(archive-int-to-mode): Construct the string directly.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
32484
diff
changeset
|
528 (if (zerop (logand 16 mode)) ?- ?w) |
3fa9dd549e89
(archive-int-to-mode): Construct the string directly.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
32484
diff
changeset
|
529 (if (zerop (logand 8 mode)) |
3fa9dd549e89
(archive-int-to-mode): Construct the string directly.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
32484
diff
changeset
|
530 (if (zerop (logand 2048 mode)) ?- ?S) |
3fa9dd549e89
(archive-int-to-mode): Construct the string directly.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
32484
diff
changeset
|
531 (if (zerop (logand 2048 mode)) ?x ?s)) |
3fa9dd549e89
(archive-int-to-mode): Construct the string directly.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
32484
diff
changeset
|
532 (if (zerop (logand 4 mode)) ?- ?r) |
3fa9dd549e89
(archive-int-to-mode): Construct the string directly.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
32484
diff
changeset
|
533 (if (zerop (logand 2 mode)) ?- ?w) |
3fa9dd549e89
(archive-int-to-mode): Construct the string directly.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
32484
diff
changeset
|
534 (if (zerop (logand 1 mode)) ?- ?x))) |
11880 | 535 |
536 (defun archive-calc-mode (oldmode newmode &optional error) | |
12791
61bbb487bf2c
Standardize layout of doc strings.
Richard M. Stallman <rms@gnu.org>
parents:
12756
diff
changeset
|
537 "From the integer OLDMODE and the string NEWMODE calculate a new file mode. |
11880 | 538 NEWMODE may be an octal number including a leading zero in which case it |
539 will become the new mode.\n | |
540 NEWMODE may also be a relative specification like \"og-rwx\" in which case | |
541 OLDMODE will be modified accordingly just like chmod(2) would have done.\n | |
542 If optional third argument ERROR is non-nil an error will be signaled if | |
543 the mode is invalid. If ERROR is nil then nil will be returned." | |
544 (cond ((string-match "^0[0-7]*$" newmode) | |
545 (let ((result 0) | |
546 (len (length newmode)) | |
547 (i 1)) | |
548 (while (< i len) | |
549 (setq result (+ (lsh result 3) (aref newmode i) (- ?0)) | |
550 i (1+ i))) | |
551 (logior (logand oldmode 65024) result))) | |
552 ((string-match "^\\([agou]+\\)\\([---+=]\\)\\([rwxst]+\\)$" newmode) | |
553 (let ((who 0) | |
554 (result oldmode) | |
555 (op (aref newmode (match-beginning 2))) | |
556 (bits 0) | |
557 (i (match-beginning 3))) | |
558 (while (< i (match-end 3)) | |
559 (let ((rwx (aref newmode i))) | |
560 (setq bits (logior bits (cond ((= rwx ?r) 292) | |
561 ((= rwx ?w) 146) | |
562 ((= rwx ?x) 73) | |
563 ((= rwx ?s) 3072) | |
564 ((= rwx ?t) 512))) | |
565 i (1+ i)))) | |
566 (while (< who (match-end 1)) | |
567 (let* ((whoc (aref newmode who)) | |
568 (whomask (cond ((= whoc ?a) 4095) | |
569 ((= whoc ?u) 1472) | |
570 ((= whoc ?g) 2104) | |
571 ((= whoc ?o) 7)))) | |
572 (if (= op ?=) | |
573 (setq result (logand result (lognot whomask)))) | |
574 (if (= op ?-) | |
575 (setq result (logand result (lognot (logand whomask bits)))) | |
576 (setq result (logior result (logand whomask bits))))) | |
577 (setq who (1+ who))) | |
578 result)) | |
579 (t | |
580 (if error | |
581 (error "Invalid mode specification: %s" newmode))))) | |
582 | |
583 (defun archive-dosdate (date) | |
584 "Stringify dos packed DATE record." | |
585 (let ((year (+ 1980 (logand (ash date -9) 127))) | |
586 (month (logand (ash date -5) 15)) | |
587 (day (logand date 31))) | |
588 (if (or (> month 12) (< month 1)) | |
589 "" | |
590 (format "%2d-%s-%d" | |
591 day | |
592 (aref ["Jan" "Feb" "Mar" "Apr" "May" "Jun" | |
593 "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"] (1- month)) | |
594 year)))) | |
595 | |
596 (defun archive-dostime (time) | |
597 "Stringify dos packed TIME record." | |
598 (let ((hour (logand (ash time -11) 31)) | |
39180
f952f4f3d625
(archive-dostime): Fix a typo in minutes' computation.
Eli Zaretskii <eliz@gnu.org>
parents:
38409
diff
changeset
|
599 (minute (logand (ash time -5) 63)) |
11880 | 600 (second (* 2 (logand time 31)))) ; 2 seconds resolution |
601 (format "%02d:%02d:%02d" hour minute second))) | |
602 | |
49437
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
603 (defun archive-unixdate (low high) |
64528
54d2ccd509bc
(archive-get-descr, archive-alternate-display): Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
64091
diff
changeset
|
604 "Stringify Unix (LOW HIGH) date." |
49437
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
605 (let ((str (current-time-string (cons high low)))) |
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
606 (format "%s-%s-%s" |
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
607 (substring str 8 10) |
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
608 (substring str 4 7) |
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
609 (substring str 20 24)))) |
11880 | 610 |
49437
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
611 (defun archive-unixtime (low high) |
64528
54d2ccd509bc
(archive-get-descr, archive-alternate-display): Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
64091
diff
changeset
|
612 "Stringify Unix (LOW HIGH) time." |
49437
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
613 (let ((str (current-time-string (cons high low)))) |
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
614 (substring str 11 19))) |
11880 | 615 |
616 (defun archive-get-lineno () | |
617 (if (>= (point) archive-file-list-start) | |
618 (count-lines archive-file-list-start | |
619 (save-excursion (beginning-of-line) (point))) | |
620 0)) | |
621 | |
622 (defun archive-get-descr (&optional noerror) | |
12791
61bbb487bf2c
Standardize layout of doc strings.
Richard M. Stallman <rms@gnu.org>
parents:
12756
diff
changeset
|
623 "Return the descriptor vector for file at point. |
64528
54d2ccd509bc
(archive-get-descr, archive-alternate-display): Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
64091
diff
changeset
|
624 Does not signal an error if optional argument NOERROR is non-nil." |
11880 | 625 (let ((no (archive-get-lineno))) |
626 (if (and (>= (point) archive-file-list-start) | |
627 (< no (length archive-files))) | |
628 (let ((item (aref archive-files no))) | |
629 (if (vectorp item) | |
630 item | |
631 (if (not noerror) | |
632 (error "Entry is not a regular member of the archive")))) | |
633 (if (not noerror) | |
634 (error "Line does not describe a member of the archive"))))) | |
635 ;; ------------------------------------------------------------------------- | |
84661
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
636 ;;; Section: the mode definition |
11880 | 637 |
12437
c3597b66e4bf
(archive-mode): Add autoload cookie.
Richard M. Stallman <rms@gnu.org>
parents:
12304
diff
changeset
|
638 ;;;###autoload |
11880 | 639 (defun archive-mode (&optional force) |
12791
61bbb487bf2c
Standardize layout of doc strings.
Richard M. Stallman <rms@gnu.org>
parents:
12756
diff
changeset
|
640 "Major mode for viewing an archive file in a dired-like way. |
61bbb487bf2c
Standardize layout of doc strings.
Richard M. Stallman <rms@gnu.org>
parents:
12756
diff
changeset
|
641 You can move around using the usual cursor motion commands. |
11880 | 642 Letters no longer insert themselves. |
643 Type `e' to pull a file out of the archive and into its own buffer; | |
644 or click mouse-2 on the file's line in the archive mode buffer. | |
645 | |
646 If you edit a sub-file of this archive (as with the `e' command) and | |
647 save it, the contents of that buffer will be saved back into the | |
648 archive. | |
649 | |
650 \\{archive-mode-map}" | |
651 ;; This is not interactive because you shouldn't be turning this | |
652 ;; mode on and off. You can corrupt things that way. | |
653 (if (zerop (buffer-size)) | |
654 ;; At present we cannot create archives from scratch | |
104684
b1cb2e195329
* arc-mode.el (archive-mode):
Juanma Barranquero <lekktu@gmail.com>
parents:
104682
diff
changeset
|
655 (funcall (or (default-value 'major-mode) 'fundamental-mode)) |
11880 | 656 (if (and (not force) archive-files) nil |
657 (let* ((type (archive-find-type)) | |
37645
3fa9dd549e89
(archive-int-to-mode): Construct the string directly.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
32484
diff
changeset
|
658 (typename (capitalize (symbol-name type)))) |
11880 | 659 (kill-all-local-variables) |
660 (make-local-variable 'archive-subtype) | |
661 (setq archive-subtype type) | |
662 | |
663 ;; Buffer contains treated image of file before the file contents | |
664 (make-local-variable 'revert-buffer-function) | |
665 (setq revert-buffer-function 'archive-mode-revert) | |
666 (auto-save-mode 0) | |
667 | |
22062
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
668 ;; Remote archives are not written by a hook. |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
669 (if archive-remote nil |
63891
d7d21c20c225
(archive-extract): Make it work as a mouse binding.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
63889
diff
changeset
|
670 (add-hook 'write-contents-functions 'archive-write-file nil t)) |
22062
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
671 |
11880 | 672 (make-local-variable 'require-final-newline) |
673 (setq require-final-newline nil) | |
22472
7d99675ff55f
(archive-mode): Locally bind local-enable-local-variables, not
Richard M. Stallman <rms@gnu.org>
parents:
22327
diff
changeset
|
674 (make-local-variable 'local-enable-local-variables) |
7d99675ff55f
(archive-mode): Locally bind local-enable-local-variables, not
Richard M. Stallman <rms@gnu.org>
parents:
22327
diff
changeset
|
675 (setq local-enable-local-variables nil) |
11880 | 676 |
23481
4e3bead33d34
(archive-mode): Locally set file-precious-flag.
Richard M. Stallman <rms@gnu.org>
parents:
23467
diff
changeset
|
677 ;; Prevent loss of data when saving the file. |
4e3bead33d34
(archive-mode): Locally set file-precious-flag.
Richard M. Stallman <rms@gnu.org>
parents:
23467
diff
changeset
|
678 (make-local-variable 'file-precious-flag) |
4e3bead33d34
(archive-mode): Locally set file-precious-flag.
Richard M. Stallman <rms@gnu.org>
parents:
23467
diff
changeset
|
679 (setq file-precious-flag t) |
4e3bead33d34
(archive-mode): Locally set file-precious-flag.
Richard M. Stallman <rms@gnu.org>
parents:
23467
diff
changeset
|
680 |
11880 | 681 (make-local-variable 'archive-read-only) |
22062
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
682 ;; Archives which are inside other archives and whose |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
683 ;; names are invalid for this OS, can't be written. |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
684 (setq archive-read-only |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
685 (or (not (file-writable-p (buffer-file-name))) |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
686 (and archive-subfile-mode |
22174
18a455216af7
(archive-file-name-invalid-regexp): Remove.
Eli Zaretskii <eliz@gnu.org>
parents:
22096
diff
changeset
|
687 (string-match file-name-invalid-regexp |
22062
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
688 (aref archive-subfile-mode 0))))) |
11880 | 689 |
690 ;; Should we use a local copy when accessing from outside Emacs? | |
691 (make-local-variable 'archive-local-name) | |
22062
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
692 |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
693 ;; An archive can contain another archive whose name is invalid |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
694 ;; on local filesystem. Treat such archives as remote. |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
695 (or archive-remote |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
696 (setq archive-remote |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
697 (or (string-match archive-remote-regexp (buffer-file-name)) |
22174
18a455216af7
(archive-file-name-invalid-regexp): Remove.
Eli Zaretskii <eliz@gnu.org>
parents:
22096
diff
changeset
|
698 (string-match file-name-invalid-regexp |
22062
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
699 (buffer-file-name))))) |
11880 | 700 |
701 (setq major-mode 'archive-mode) | |
702 (setq mode-name (concat typename "-Archive")) | |
703 ;; Run archive-foo-mode-hook and archive-mode-hook | |
62714
ec0621e2b94f
(archive-mode): Use run-mode-hooks.
Lute Kamstra <lute@gnu.org>
parents:
61414
diff
changeset
|
704 (run-mode-hooks (archive-name "mode-hook") 'archive-mode-hook) |
11880 | 705 (use-local-map archive-mode-map)) |
706 | |
707 (make-local-variable 'archive-proper-file-start) | |
708 (make-local-variable 'archive-file-list-start) | |
709 (make-local-variable 'archive-file-list-end) | |
710 (make-local-variable 'archive-file-name-indent) | |
88954
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
711 (setq archive-file-name-coding-system |
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
712 (or file-name-coding-system |
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
713 default-file-name-coding-system |
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
714 locale-coding-system)) |
104823
68150c643e2e
Use default-value rather than default-enable-multibyte-characters.
Glenn Morris <rgm@gnu.org>
parents:
104684
diff
changeset
|
715 (if (default-value 'enable-multibyte-characters) |
89483 | 716 (set-buffer-multibyte 'to)) |
22062
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
717 (archive-summarize nil) |
11880 | 718 (setq buffer-read-only t)))) |
719 | |
720 ;; Archive mode is suitable only for specially formatted data. | |
721 (put 'archive-mode 'mode-class 'special) | |
722 | |
61414
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
723 (let ((item1 '(archive-subfile-mode " Archive"))) |
11880 | 724 (or (member item1 minor-mode-alist) |
61414
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
725 (setq minor-mode-alist (cons item1 minor-mode-alist)))) |
11880 | 726 ;; ------------------------------------------------------------------------- |
727 (defun archive-find-type () | |
728 (widen) | |
729 (goto-char (point-min)) | |
730 ;; The funny [] here make it unlikely that the .elc file will be treated | |
731 ;; as an archive by other software. | |
732 (let (case-fold-search) | |
103871
819d4646794e
* arc-mode.el (archive-find-type): Allow for a PK00 string before
Chong Yidong <cyd@stupidchicken.com>
parents:
102732
diff
changeset
|
733 (cond ((looking-at "\\(PK00\\)?[P]K\003\004") 'zip) |
20767
ad6c6f1bd674
(archive-find-type): Accept d or s after digit, for lzh.
Richard M. Stallman <rms@gnu.org>
parents:
20239
diff
changeset
|
734 ((looking-at "..-l[hz][0-9ds]-") 'lzh) |
11880 | 735 ((looking-at "....................[\334]\247\304\375") 'zoo) |
736 ((and (looking-at "\C-z") ; signature too simple, IMHO | |
737 (string-match "\\.[aA][rR][cC]$" | |
738 (or buffer-file-name (buffer-name)))) | |
739 'arc) | |
96360
b4fbe199423a
American English spelling fix.
Glenn Morris <rgm@gnu.org>
parents:
95366
diff
changeset
|
740 ;; This pattern modeled on the BSD/GNU+Linux `file' command. |
77330
1b3aff56da73
(archive-find-type): lzh-exe for lzh self-extracting exe.
Chong Yidong <cyd@stupidchicken.com>
parents:
77274
diff
changeset
|
741 ;; Have seen capital "LHA's", and file has lower case "LHa's" too. |
1b3aff56da73
(archive-find-type): lzh-exe for lzh self-extracting exe.
Chong Yidong <cyd@stupidchicken.com>
parents:
77274
diff
changeset
|
742 ;; Note this regexp is also in archive-exe-p. |
1b3aff56da73
(archive-find-type): lzh-exe for lzh self-extracting exe.
Chong Yidong <cyd@stupidchicken.com>
parents:
77274
diff
changeset
|
743 ((looking-at "MZ\\(.\\|\n\\)\\{34\\}LH[aA]'s SFX ") 'lzh-exe) |
84661
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
744 ((looking-at "Rar!") 'rar) |
92538
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
745 ((looking-at "!<arch>\n") 'ar) |
86928
29dfee94a77f
(archive-find-type): Add recognition of rar-exe format.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
84661
diff
changeset
|
746 ((and (looking-at "MZ") |
29dfee94a77f
(archive-find-type): Add recognition of rar-exe format.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
84661
diff
changeset
|
747 (re-search-forward "Rar!" (+ (point) 100000) t)) |
29dfee94a77f
(archive-find-type): Add recognition of rar-exe format.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
84661
diff
changeset
|
748 'rar-exe) |
107896
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
749 ((looking-at "7z\274\257\047\034") '7z) |
38409
153f1b1f2efd
Emacs lisp coding convention fixes.
Pavel Janík <Pavel@Janik.cz>
parents:
38072
diff
changeset
|
750 (t (error "Buffer format not recognized"))))) |
11880 | 751 ;; ------------------------------------------------------------------------- |
84661
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
752 |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
753 (defun archive-desummarize () |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
754 (let ((inhibit-read-only t) |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
755 (modified (buffer-modified-p))) |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
756 (widen) |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
757 (delete-region (point-min) archive-proper-file-start) |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
758 (restore-buffer-modified-p modified))) |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
759 |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
760 |
22062
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
761 (defun archive-summarize (&optional shut-up) |
11880 | 762 "Parse the contents of the archive file in the current buffer. |
763 Place a dired-like listing on the front; | |
764 then narrow to it, so that only that listing | |
22062
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
765 is visible (and the real data of the buffer is hidden). |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
766 Optional argument SHUT-UP, if non-nil, means don't print messages |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
767 when parsing the archive." |
11880 | 768 (widen) |
63889
abe14daaa679
Bind inhibit-read-only rather than buffer-read-only.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
62714
diff
changeset
|
769 (let ((inhibit-read-only t)) |
84661
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
770 (setq archive-proper-file-start (copy-marker (point-min) t)) |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
771 (set (make-local-variable 'change-major-mode-hook) 'archive-desummarize) |
22062
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
772 (or shut-up |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
773 (message "Parsing archive file...")) |
11880 | 774 (buffer-disable-undo (current-buffer)) |
775 (setq archive-files (funcall (archive-name "summarize"))) | |
22062
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
776 (or shut-up |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
777 (message "Parsing archive file...done.")) |
11880 | 778 (setq archive-proper-file-start (point-marker)) |
779 (narrow-to-region (point-min) (point)) | |
780 (set-buffer-modified-p nil) | |
781 (buffer-enable-undo)) | |
782 (goto-char archive-file-list-start) | |
783 (archive-next-line 0)) | |
784 | |
785 (defun archive-resummarize () | |
786 "Recreate the contents listing of an archive." | |
84661
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
787 (let ((no (archive-get-lineno))) |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
788 (archive-desummarize) |
22062
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
789 (archive-summarize t) |
11880 | 790 (goto-char archive-file-list-start) |
791 (archive-next-line no))) | |
792 | |
793 (defun archive-summarize-files (files) | |
16291 | 794 "Insert a description of a list of files annotated with proper mouse face." |
11880 | 795 (setq archive-file-list-start (point-marker)) |
796 (setq archive-file-name-indent (if files (aref (car files) 1) 0)) | |
797 ;; We don't want to do an insert for each element since that takes too | |
798 ;; long when the archive -- which has to be moved in memory -- is large. | |
799 (insert | |
800 (apply | |
801 (function concat) | |
802 (mapcar | |
63891
d7d21c20c225
(archive-extract): Make it work as a mouse binding.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
63889
diff
changeset
|
803 (lambda (fil) |
d7d21c20c225
(archive-extract): Make it work as a mouse binding.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
63889
diff
changeset
|
804 ;; Using `concat' here copies the text also, so we can add |
d7d21c20c225
(archive-extract): Make it work as a mouse binding.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
63889
diff
changeset
|
805 ;; properties without problems. |
d7d21c20c225
(archive-extract): Make it work as a mouse binding.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
63889
diff
changeset
|
806 (let ((text (concat (aref fil 0) "\n"))) |
d7d21c20c225
(archive-extract): Make it work as a mouse binding.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
63889
diff
changeset
|
807 (if (featurep 'xemacs) |
d7d21c20c225
(archive-extract): Make it work as a mouse binding.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
63889
diff
changeset
|
808 () ; out of luck |
d7d21c20c225
(archive-extract): Make it work as a mouse binding.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
63889
diff
changeset
|
809 (add-text-properties |
d7d21c20c225
(archive-extract): Make it work as a mouse binding.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
63889
diff
changeset
|
810 (aref fil 1) (aref fil 2) |
d7d21c20c225
(archive-extract): Make it work as a mouse binding.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
63889
diff
changeset
|
811 '(mouse-face highlight |
d7d21c20c225
(archive-extract): Make it work as a mouse binding.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
63889
diff
changeset
|
812 help-echo "mouse-2: extract this file into a buffer") |
d7d21c20c225
(archive-extract): Make it work as a mouse binding.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
63889
diff
changeset
|
813 text)) |
d7d21c20c225
(archive-extract): Make it work as a mouse binding.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
63889
diff
changeset
|
814 text)) |
11880 | 815 files))) |
816 (setq archive-file-list-end (point-marker))) | |
817 | |
818 (defun archive-alternate-display () | |
12791
61bbb487bf2c
Standardize layout of doc strings.
Richard M. Stallman <rms@gnu.org>
parents:
12756
diff
changeset
|
819 "Toggle alternative display. |
64528
54d2ccd509bc
(archive-get-descr, archive-alternate-display): Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
64091
diff
changeset
|
820 To avoid very long lines archive mode does not show all information. |
12791
61bbb487bf2c
Standardize layout of doc strings.
Richard M. Stallman <rms@gnu.org>
parents:
12756
diff
changeset
|
821 This function changes the set of information shown for each files." |
11880 | 822 (interactive) |
823 (setq archive-alternate-display (not archive-alternate-display)) | |
824 (archive-resummarize)) | |
825 ;; ------------------------------------------------------------------------- | |
84661
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
826 ;;; Section: Local archive copy handling |
11880 | 827 |
22062
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
828 (defun archive-unique-fname (fname dir) |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
829 "Make sure a file FNAME can be created uniquely in directory DIR. |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
830 |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
831 If FNAME can be uniquely created in DIR, it is returned unaltered. |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
832 If FNAME is something our underlying filesystem can't grok, or if another |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
833 file by that name already exists in DIR, a unique new name is generated |
37645
3fa9dd549e89
(archive-int-to-mode): Construct the string directly.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
32484
diff
changeset
|
834 using `make-temp-file', and the generated name is returned." |
22062
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
835 (let ((fullname (expand-file-name fname dir)) |
106026
199c98e07acd
* arc-mode.el (archive-maybe-copy): Move creation of directory ...
Michael Albinus <michael.albinus@gmx.de>
parents:
104823
diff
changeset
|
836 (alien (string-match file-name-invalid-regexp fname)) |
199c98e07acd
* arc-mode.el (archive-maybe-copy): Move creation of directory ...
Michael Albinus <michael.albinus@gmx.de>
parents:
104823
diff
changeset
|
837 (tmpfile |
22062
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
838 (expand-file-name |
49238
86973b914660
(archive-arc-rename-entry): Fix error message.
Kim F. Storm <storm@cua.dk>
parents:
49166
diff
changeset
|
839 (if (if (fboundp 'msdos-long-file-names) |
86973b914660
(archive-arc-rename-entry): Fix error message.
Kim F. Storm <storm@cua.dk>
parents:
49166
diff
changeset
|
840 (not (msdos-long-file-names))) |
22062
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
841 "am" |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
842 "arc-mode.") |
106026
199c98e07acd
* arc-mode.el (archive-maybe-copy): Move creation of directory ...
Michael Albinus <michael.albinus@gmx.de>
parents:
104823
diff
changeset
|
843 dir))) |
199c98e07acd
* arc-mode.el (archive-maybe-copy): Move creation of directory ...
Michael Albinus <michael.albinus@gmx.de>
parents:
104823
diff
changeset
|
844 (if (or alien (file-exists-p fullname)) |
199c98e07acd
* arc-mode.el (archive-maybe-copy): Move creation of directory ...
Michael Albinus <michael.albinus@gmx.de>
parents:
104823
diff
changeset
|
845 (progn |
199c98e07acd
* arc-mode.el (archive-maybe-copy): Move creation of directory ...
Michael Albinus <michael.albinus@gmx.de>
parents:
104823
diff
changeset
|
846 ;; Maked sure all the leading directories in |
199c98e07acd
* arc-mode.el (archive-maybe-copy): Move creation of directory ...
Michael Albinus <michael.albinus@gmx.de>
parents:
104823
diff
changeset
|
847 ;; archive-local-name exist under archive-tmpdir, so that |
199c98e07acd
* arc-mode.el (archive-maybe-copy): Move creation of directory ...
Michael Albinus <michael.albinus@gmx.de>
parents:
104823
diff
changeset
|
848 ;; the directory structure recorded in the archive is |
199c98e07acd
* arc-mode.el (archive-maybe-copy): Move creation of directory ...
Michael Albinus <michael.albinus@gmx.de>
parents:
104823
diff
changeset
|
849 ;; reconstructed in the temporary directory. |
199c98e07acd
* arc-mode.el (archive-maybe-copy): Move creation of directory ...
Michael Albinus <michael.albinus@gmx.de>
parents:
104823
diff
changeset
|
850 (make-directory (file-name-directory tmpfile) t) |
199c98e07acd
* arc-mode.el (archive-maybe-copy): Move creation of directory ...
Michael Albinus <michael.albinus@gmx.de>
parents:
104823
diff
changeset
|
851 (make-temp-file tmpfile)) |
107136
00c6bb12d924
* arc-mode.el (archive-unique-fname): Make directories for nested
Juri Linkov <juri@jurta.org>
parents:
107071
diff
changeset
|
852 ;; Maked sure all the leading directories in `fullname' exist |
00c6bb12d924
* arc-mode.el (archive-unique-fname): Make directories for nested
Juri Linkov <juri@jurta.org>
parents:
107071
diff
changeset
|
853 ;; under archive-tmpdir. This is necessary for nested archives |
00c6bb12d924
* arc-mode.el (archive-unique-fname): Make directories for nested
Juri Linkov <juri@jurta.org>
parents:
107071
diff
changeset
|
854 ;; (`archive-extract' sets `archive-remote' to t in case |
00c6bb12d924
* arc-mode.el (archive-unique-fname): Make directories for nested
Juri Linkov <juri@jurta.org>
parents:
107071
diff
changeset
|
855 ;; an archive occurs inside another archive). |
00c6bb12d924
* arc-mode.el (archive-unique-fname): Make directories for nested
Juri Linkov <juri@jurta.org>
parents:
107071
diff
changeset
|
856 (make-directory (file-name-directory fullname) t) |
22062
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
857 fullname))) |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
858 |
11880 | 859 (defun archive-maybe-copy (archive) |
22062
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
860 (let ((coding-system-for-write 'no-conversion)) |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
861 (if archive-remote |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
862 (let ((start (point-max)) |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
863 ;; Sometimes ARCHIVE is invalid while its actual name, as |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
864 ;; recorded in its parent archive, is not. For example, an |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
865 ;; archive bar.zip inside another archive foo.zip gets a name |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
866 ;; "foo.zip:bar.zip", which is invalid on DOS/Windows. |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
867 ;; So use the actual name if available. |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
868 (archive-name |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
869 (or (and archive-subfile-mode (aref archive-subfile-mode 0)) |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
870 archive))) |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
871 (setq archive-local-name |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
872 (archive-unique-fname archive-name archive-tmpdir)) |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
873 (save-restriction |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
874 (widen) |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
875 (write-region start (point-max) archive-local-name nil 'nomessage)) |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
876 archive-local-name) |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
877 (if (buffer-modified-p) (save-buffer)) |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
878 archive))) |
11880 | 879 |
880 (defun archive-maybe-update (unchanged) | |
881 (if archive-remote | |
882 (let ((name archive-local-name) | |
883 (modified (buffer-modified-p)) | |
22062
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
884 (coding-system-for-read 'no-conversion) |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
885 (lno (archive-get-lineno)) |
63889
abe14daaa679
Bind inhibit-read-only rather than buffer-read-only.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
62714
diff
changeset
|
886 (inhibit-read-only t)) |
11880 | 887 (if unchanged nil |
22062
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
888 (setq archive-files nil) |
11880 | 889 (erase-buffer) |
890 (insert-file-contents name) | |
22062
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
891 (archive-mode t) |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
892 (goto-char archive-file-list-start) |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
893 (archive-next-line lno)) |
11880 | 894 (archive-delete-local name) |
895 (if (not unchanged) | |
22062
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
896 (message |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
897 "Buffer `%s' must be saved for changes to take effect" |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
898 (buffer-name (current-buffer)))) |
11880 | 899 (set-buffer-modified-p (or modified (not unchanged)))))) |
900 | |
901 (defun archive-delete-local (name) | |
12791
61bbb487bf2c
Standardize layout of doc strings.
Richard M. Stallman <rms@gnu.org>
parents:
12756
diff
changeset
|
902 "Delete file NAME and its parents up to and including `archive-tmpdir'." |
11880 | 903 (let ((again t) |
904 (top (directory-file-name (file-name-as-directory archive-tmpdir)))) | |
905 (condition-case nil | |
906 (delete-file name) | |
907 (error nil)) | |
908 (while again | |
909 (setq name (directory-file-name (file-name-directory name))) | |
910 (condition-case nil | |
911 (delete-directory name) | |
912 (error nil)) | |
913 (if (string= name top) (setq again nil))))) | |
914 ;; ------------------------------------------------------------------------- | |
84661
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
915 ;;; Section: Member extraction |
11880 | 916 |
93613
1cee153604e6
(archive-mode-map): Obey mouse-1-click-follows-link.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92538
diff
changeset
|
917 (defun archive-try-jka-compr () |
1cee153604e6
(archive-mode-map): Obey mouse-1-click-follows-link.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92538
diff
changeset
|
918 (when (and auto-compression-mode |
1cee153604e6
(archive-mode-map): Obey mouse-1-click-follows-link.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92538
diff
changeset
|
919 (jka-compr-get-compression-info buffer-file-name)) |
1cee153604e6
(archive-mode-map): Obey mouse-1-click-follows-link.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92538
diff
changeset
|
920 (let* ((basename (file-name-nondirectory buffer-file-name)) |
1cee153604e6
(archive-mode-map): Obey mouse-1-click-follows-link.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92538
diff
changeset
|
921 (tmpname (if (string-match ":\\([^:]+\\)\\'" basename) |
1cee153604e6
(archive-mode-map): Obey mouse-1-click-follows-link.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92538
diff
changeset
|
922 (match-string 1 basename) basename)) |
1cee153604e6
(archive-mode-map): Obey mouse-1-click-follows-link.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92538
diff
changeset
|
923 (tmpfile (make-temp-file (file-name-sans-extension tmpname) |
1cee153604e6
(archive-mode-map): Obey mouse-1-click-follows-link.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92538
diff
changeset
|
924 nil |
1cee153604e6
(archive-mode-map): Obey mouse-1-click-follows-link.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92538
diff
changeset
|
925 (file-name-extension tmpname 'period)))) |
1cee153604e6
(archive-mode-map): Obey mouse-1-click-follows-link.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92538
diff
changeset
|
926 (unwind-protect |
1cee153604e6
(archive-mode-map): Obey mouse-1-click-follows-link.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92538
diff
changeset
|
927 (progn |
1cee153604e6
(archive-mode-map): Obey mouse-1-click-follows-link.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92538
diff
changeset
|
928 (let ((coding-system-for-write 'no-conversion) |
1cee153604e6
(archive-mode-map): Obey mouse-1-click-follows-link.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92538
diff
changeset
|
929 ;; Don't re-compress this data just before decompressing it. |
1cee153604e6
(archive-mode-map): Obey mouse-1-click-follows-link.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92538
diff
changeset
|
930 (jka-compr-inhibit t)) |
1cee153604e6
(archive-mode-map): Obey mouse-1-click-follows-link.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92538
diff
changeset
|
931 (write-region (point-min) (point-max) tmpfile nil 'quiet)) |
1cee153604e6
(archive-mode-map): Obey mouse-1-click-follows-link.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92538
diff
changeset
|
932 (erase-buffer) |
1cee153604e6
(archive-mode-map): Obey mouse-1-click-follows-link.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92538
diff
changeset
|
933 (let ((coding-system-for-read 'no-conversion)) |
1cee153604e6
(archive-mode-map): Obey mouse-1-click-follows-link.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92538
diff
changeset
|
934 (insert-file-contents tmpfile))) |
1cee153604e6
(archive-mode-map): Obey mouse-1-click-follows-link.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92538
diff
changeset
|
935 (delete-file tmpfile))))) |
1cee153604e6
(archive-mode-map): Obey mouse-1-click-follows-link.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92538
diff
changeset
|
936 |
22830
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
937 (defun archive-file-name-handler (op &rest args) |
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
938 (or (eq op 'file-exists-p) |
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
939 (let ((file-name-handler-alist nil)) |
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
940 (apply op args)))) |
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
941 |
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
942 (defun archive-set-buffer-as-visiting-file (filename) |
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
943 "Set the current buffer as if it were visiting FILENAME." |
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
944 (save-excursion |
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
945 (goto-char (point-min)) |
70544
2400f78c17e8
(archive-set-buffer-as-visiting-file): Bind buffer-undo-list
Juri Linkov <juri@jurta.org>
parents:
70388
diff
changeset
|
946 (let ((buffer-undo-list t) |
2400f78c17e8
(archive-set-buffer-as-visiting-file): Bind buffer-undo-list
Juri Linkov <juri@jurta.org>
parents:
70388
diff
changeset
|
947 (coding |
22830
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
948 (or coding-system-for-read |
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
949 (and set-auto-coding-function |
24381
b3c0f3ad64d8
(archive-set-buffer-as-visiting-file): Save
Eli Zaretskii <eliz@gnu.org>
parents:
23481
diff
changeset
|
950 (save-excursion |
b3c0f3ad64d8
(archive-set-buffer-as-visiting-file): Save
Eli Zaretskii <eliz@gnu.org>
parents:
23481
diff
changeset
|
951 (funcall set-auto-coding-function |
b3c0f3ad64d8
(archive-set-buffer-as-visiting-file): Save
Eli Zaretskii <eliz@gnu.org>
parents:
23481
diff
changeset
|
952 filename (- (point-max) (point-min))))) |
72054
bf3518b64c99
(archive-set-buffer-as-visiting-file): Comment fix.
Eli Zaretskii <eliz@gnu.org>
parents:
70946
diff
changeset
|
953 ;; dos-w32.el defines the function |
bf3518b64c99
(archive-set-buffer-as-visiting-file): Comment fix.
Eli Zaretskii <eliz@gnu.org>
parents:
70946
diff
changeset
|
954 ;; find-buffer-file-type-coding-system for DOS/Windows |
bf3518b64c99
(archive-set-buffer-as-visiting-file): Comment fix.
Eli Zaretskii <eliz@gnu.org>
parents:
70946
diff
changeset
|
955 ;; systems which preserves the coding-system of existing files. |
bf3518b64c99
(archive-set-buffer-as-visiting-file): Comment fix.
Eli Zaretskii <eliz@gnu.org>
parents:
70946
diff
changeset
|
956 ;; (That function is called via file-coding-system-alist.) |
bf3518b64c99
(archive-set-buffer-as-visiting-file): Comment fix.
Eli Zaretskii <eliz@gnu.org>
parents:
70946
diff
changeset
|
957 ;; Here, we want it to act as if the extracted file existed. |
bf3518b64c99
(archive-set-buffer-as-visiting-file): Comment fix.
Eli Zaretskii <eliz@gnu.org>
parents:
70946
diff
changeset
|
958 ;; The following let-binding of file-name-handler-alist forces |
bf3518b64c99
(archive-set-buffer-as-visiting-file): Comment fix.
Eli Zaretskii <eliz@gnu.org>
parents:
70946
diff
changeset
|
959 ;; find-file-not-found-set-buffer-file-coding-system to ignore |
bf3518b64c99
(archive-set-buffer-as-visiting-file): Comment fix.
Eli Zaretskii <eliz@gnu.org>
parents:
70946
diff
changeset
|
960 ;; the file's name (see dos-w32.el). |
22830
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
961 (let ((file-name-handler-alist |
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
962 '(("" . archive-file-name-handler)))) |
70946
f3c65e2e68b3
(archive-set-buffer-as-visiting-file): Call
Kenichi Handa <handa@m17n.org>
parents:
70679
diff
changeset
|
963 (car (find-operation-coding-system |
f3c65e2e68b3
(archive-set-buffer-as-visiting-file): Call
Kenichi Handa <handa@m17n.org>
parents:
70679
diff
changeset
|
964 'insert-file-contents |
f3c65e2e68b3
(archive-set-buffer-as-visiting-file): Call
Kenichi Handa <handa@m17n.org>
parents:
70679
diff
changeset
|
965 (cons filename (current-buffer)) t)))))) |
93613
1cee153604e6
(archive-mode-map): Obey mouse-1-click-follows-link.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92538
diff
changeset
|
966 (unless (or coding-system-for-read |
1cee153604e6
(archive-mode-map): Obey mouse-1-click-follows-link.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92538
diff
changeset
|
967 enable-multibyte-characters) |
1cee153604e6
(archive-mode-map): Obey mouse-1-click-follows-link.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92538
diff
changeset
|
968 (setq coding |
1cee153604e6
(archive-mode-map): Obey mouse-1-click-follows-link.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92538
diff
changeset
|
969 (coding-system-change-text-conversion coding 'raw-text))) |
1cee153604e6
(archive-mode-map): Obey mouse-1-click-follows-link.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92538
diff
changeset
|
970 (unless (memq coding '(nil no-conversion)) |
1cee153604e6
(archive-mode-map): Obey mouse-1-click-follows-link.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92538
diff
changeset
|
971 (decode-coding-region (point-min) (point-max) coding) |
22830
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
972 (setq last-coding-system-used coding)) |
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
973 (set-buffer-modified-p nil) |
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
974 (kill-local-variable 'buffer-file-coding-system) |
50835
b7770bea6205
(archive-set-buffer-as-visiting-file): Use
Kenichi Handa <handa@m17n.org>
parents:
50136
diff
changeset
|
975 (after-insert-file-set-coding (- (point-max) (point-min)))))) |
22830
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
976 |
63891
d7d21c20c225
(archive-extract): Make it work as a mouse binding.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
63889
diff
changeset
|
977 (define-obsolete-function-alias 'archive-mouse-extract 'archive-extract "22.1") |
11880 | 978 |
63891
d7d21c20c225
(archive-extract): Make it work as a mouse binding.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
63889
diff
changeset
|
979 (defun archive-extract (&optional other-window-p event) |
11880 | 980 "In archive mode, extract this entry of the archive into its own buffer." |
63891
d7d21c20c225
(archive-extract): Make it work as a mouse binding.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
63889
diff
changeset
|
981 (interactive (list nil last-input-event)) |
67138
aa8ad01ef0c1
(archive-extract): Use `posn-set-point' instead of `mouse-set-point'
John Paul Wallington <jpw@pobox.com>
parents:
66124
diff
changeset
|
982 (if event (posn-set-point (event-end event))) |
11880 | 983 (let* ((view-p (eq other-window-p 'view)) |
984 (descr (archive-get-descr)) | |
985 (ename (aref descr 0)) | |
986 (iname (aref descr 1)) | |
987 (archive-buffer (current-buffer)) | |
988 (arcdir default-directory) | |
989 (archive (buffer-file-name)) | |
990 (arcname (file-name-nondirectory archive)) | |
991 (bufname (concat (file-name-nondirectory iname) " (" arcname ")")) | |
992 (extractor (archive-name "extract")) | |
22062
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
993 ;; Members with file names which aren't valid for the |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
994 ;; underlying filesystem, are treated as read-only. |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
995 (read-only-p (or archive-read-only |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
996 view-p |
22174
18a455216af7
(archive-file-name-invalid-regexp): Remove.
Eli Zaretskii <eliz@gnu.org>
parents:
22096
diff
changeset
|
997 (string-match file-name-invalid-regexp ename))) |
69331
619b0c2000a6
* arc-mode.el (archive-extract): Check if an existing buffer name
Chong Yidong <cyd@stupidchicken.com>
parents:
68651
diff
changeset
|
998 (arcfilename (expand-file-name (concat arcname ":" iname))) |
11880 | 999 (buffer (get-buffer bufname)) |
88954
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
1000 (just-created nil) |
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
1001 (file-name-coding archive-file-name-coding-system)) |
69331
619b0c2000a6
* arc-mode.el (archive-extract): Check if an existing buffer name
Chong Yidong <cyd@stupidchicken.com>
parents:
68651
diff
changeset
|
1002 (if (and buffer |
619b0c2000a6
* arc-mode.el (archive-extract): Check if an existing buffer name
Chong Yidong <cyd@stupidchicken.com>
parents:
68651
diff
changeset
|
1003 (string= (buffer-file-name buffer) arcfilename)) |
11880 | 1004 nil |
1005 (setq archive (archive-maybe-copy archive)) | |
69331
619b0c2000a6
* arc-mode.el (archive-extract): Check if an existing buffer name
Chong Yidong <cyd@stupidchicken.com>
parents:
68651
diff
changeset
|
1006 (setq bufname (generate-new-buffer-name bufname)) |
11880 | 1007 (setq buffer (get-buffer-create bufname)) |
1008 (setq just-created t) | |
63889
abe14daaa679
Bind inhibit-read-only rather than buffer-read-only.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
62714
diff
changeset
|
1009 (with-current-buffer buffer |
69331
619b0c2000a6
* arc-mode.el (archive-extract): Check if an existing buffer name
Chong Yidong <cyd@stupidchicken.com>
parents:
68651
diff
changeset
|
1010 (setq buffer-file-name arcfilename) |
11880 | 1011 (setq buffer-file-truename |
1012 (abbreviate-file-name buffer-file-name)) | |
1013 ;; Set the default-directory to the dir of the superior buffer. | |
1014 (setq default-directory arcdir) | |
1015 (make-local-variable 'archive-superior-buffer) | |
1016 (setq archive-superior-buffer archive-buffer) | |
63891
d7d21c20c225
(archive-extract): Make it work as a mouse binding.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
63889
diff
changeset
|
1017 (add-hook 'write-file-functions 'archive-write-file-member nil t) |
11880 | 1018 (setq archive-subfile-mode descr) |
88954
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
1019 (setq archive-file-name-coding-system file-name-coding) |
21570
e21c343b0c6e
(archive-extract-by-stdout): Don't use
Eli Zaretskii <eliz@gnu.org>
parents:
20767
diff
changeset
|
1020 (if (and |
e21c343b0c6e
(archive-extract-by-stdout): Don't use
Eli Zaretskii <eliz@gnu.org>
parents:
20767
diff
changeset
|
1021 (null |
22830
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
1022 (let (;; We may have to encode file name arguement for |
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
1023 ;; external programs. |
22834
926aae368e61
(archive-set-buffer-as-visiting-file): Give FILENAME
Kenichi Handa <handa@m17n.org>
parents:
22830
diff
changeset
|
1024 (coding-system-for-write |
926aae368e61
(archive-set-buffer-as-visiting-file): Give FILENAME
Kenichi Handa <handa@m17n.org>
parents:
22830
diff
changeset
|
1025 (and enable-multibyte-characters |
88954
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
1026 archive-file-name-coding-system)) |
22830
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
1027 ;; We read an archive member by no-conversion at |
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
1028 ;; first, then decode appropriately by calling |
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
1029 ;; archive-set-buffer-as-visiting-file later. |
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
1030 (coding-system-for-read 'no-conversion)) |
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
1031 (condition-case err |
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
1032 (if (fboundp extractor) |
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
1033 (funcall extractor archive ename) |
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
1034 (archive-*-extract archive ename |
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
1035 (symbol-value extractor))) |
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
1036 (error |
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
1037 (ding (message "%s" (error-message-string err))) |
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
1038 nil)))) |
21570
e21c343b0c6e
(archive-extract-by-stdout): Don't use
Eli Zaretskii <eliz@gnu.org>
parents:
20767
diff
changeset
|
1039 just-created) |
e21c343b0c6e
(archive-extract-by-stdout): Don't use
Eli Zaretskii <eliz@gnu.org>
parents:
20767
diff
changeset
|
1040 (progn |
e21c343b0c6e
(archive-extract-by-stdout): Don't use
Eli Zaretskii <eliz@gnu.org>
parents:
20767
diff
changeset
|
1041 (set-buffer-modified-p nil) |
e21c343b0c6e
(archive-extract-by-stdout): Don't use
Eli Zaretskii <eliz@gnu.org>
parents:
20767
diff
changeset
|
1042 (kill-buffer buffer)) |
93613
1cee153604e6
(archive-mode-map): Obey mouse-1-click-follows-link.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92538
diff
changeset
|
1043 (archive-try-jka-compr) ;Pretty ugly hack :-( |
22830
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
1044 (archive-set-buffer-as-visiting-file ename) |
21570
e21c343b0c6e
(archive-extract-by-stdout): Don't use
Eli Zaretskii <eliz@gnu.org>
parents:
20767
diff
changeset
|
1045 (goto-char (point-min)) |
e21c343b0c6e
(archive-extract-by-stdout): Don't use
Eli Zaretskii <eliz@gnu.org>
parents:
20767
diff
changeset
|
1046 (rename-buffer bufname) |
e21c343b0c6e
(archive-extract-by-stdout): Don't use
Eli Zaretskii <eliz@gnu.org>
parents:
20767
diff
changeset
|
1047 (setq buffer-read-only read-only-p) |
e21c343b0c6e
(archive-extract-by-stdout): Don't use
Eli Zaretskii <eliz@gnu.org>
parents:
20767
diff
changeset
|
1048 (setq buffer-undo-list nil) |
e21c343b0c6e
(archive-extract-by-stdout): Don't use
Eli Zaretskii <eliz@gnu.org>
parents:
20767
diff
changeset
|
1049 (set-buffer-modified-p nil) |
e21c343b0c6e
(archive-extract-by-stdout): Don't use
Eli Zaretskii <eliz@gnu.org>
parents:
20767
diff
changeset
|
1050 (setq buffer-saved-size (buffer-size)) |
e21c343b0c6e
(archive-extract-by-stdout): Don't use
Eli Zaretskii <eliz@gnu.org>
parents:
20767
diff
changeset
|
1051 (normal-mode) |
e21c343b0c6e
(archive-extract-by-stdout): Don't use
Eli Zaretskii <eliz@gnu.org>
parents:
20767
diff
changeset
|
1052 ;; Just in case an archive occurs inside another archive. |
63891
d7d21c20c225
(archive-extract): Make it work as a mouse binding.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
63889
diff
changeset
|
1053 (when (derived-mode-p 'archive-mode) |
d7d21c20c225
(archive-extract): Make it work as a mouse binding.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
63889
diff
changeset
|
1054 (setq archive-remote t) |
d7d21c20c225
(archive-extract): Make it work as a mouse binding.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
63889
diff
changeset
|
1055 (if read-only-p (setq archive-read-only t)) |
d7d21c20c225
(archive-extract): Make it work as a mouse binding.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
63889
diff
changeset
|
1056 ;; We will write out the archive ourselves if it is |
d7d21c20c225
(archive-extract): Make it work as a mouse binding.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
63889
diff
changeset
|
1057 ;; part of another archive. |
d7d21c20c225
(archive-extract): Make it work as a mouse binding.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
63889
diff
changeset
|
1058 (remove-hook 'write-contents-functions 'archive-write-file t)) |
d7d21c20c225
(archive-extract): Make it work as a mouse binding.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
63889
diff
changeset
|
1059 (run-hooks 'archive-extract-hooks) |
22062
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
1060 (if archive-read-only |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
1061 (message "Note: altering this archive is not implemented.")))) |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
1062 (archive-maybe-update t)) |
21570
e21c343b0c6e
(archive-extract-by-stdout): Don't use
Eli Zaretskii <eliz@gnu.org>
parents:
20767
diff
changeset
|
1063 (or (not (buffer-name buffer)) |
63891
d7d21c20c225
(archive-extract): Make it work as a mouse binding.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
63889
diff
changeset
|
1064 (cond |
107897
1721e4658521
Test for special mode-class in view-buffer instead of view-file (bug#5513).
Juri Linkov <juri@jurta.org>
parents:
107896
diff
changeset
|
1065 (view-p |
1721e4658521
Test for special mode-class in view-buffer instead of view-file (bug#5513).
Juri Linkov <juri@jurta.org>
parents:
107896
diff
changeset
|
1066 (view-buffer buffer (and just-created 'kill-buffer-if-not-modified))) |
63891
d7d21c20c225
(archive-extract): Make it work as a mouse binding.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
63889
diff
changeset
|
1067 ((eq other-window-p 'display) (display-buffer buffer)) |
d7d21c20c225
(archive-extract): Make it work as a mouse binding.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
63889
diff
changeset
|
1068 (other-window-p (switch-to-buffer-other-window buffer)) |
d7d21c20c225
(archive-extract): Make it work as a mouse binding.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
63889
diff
changeset
|
1069 (t (switch-to-buffer buffer)))))) |
11880 | 1070 |
1071 (defun archive-*-extract (archive name command) | |
1072 (let* ((default-directory (file-name-as-directory archive-tmpdir)) | |
1073 (tmpfile (expand-file-name (file-name-nondirectory name) | |
21570
e21c343b0c6e
(archive-extract-by-stdout): Don't use
Eli Zaretskii <eliz@gnu.org>
parents:
20767
diff
changeset
|
1074 default-directory)) |
e21c343b0c6e
(archive-extract-by-stdout): Don't use
Eli Zaretskii <eliz@gnu.org>
parents:
20767
diff
changeset
|
1075 exit-status success) |
11880 | 1076 (make-directory (directory-file-name default-directory) t) |
21570
e21c343b0c6e
(archive-extract-by-stdout): Don't use
Eli Zaretskii <eliz@gnu.org>
parents:
20767
diff
changeset
|
1077 (setq exit-status |
e21c343b0c6e
(archive-extract-by-stdout): Don't use
Eli Zaretskii <eliz@gnu.org>
parents:
20767
diff
changeset
|
1078 (apply 'call-process |
e21c343b0c6e
(archive-extract-by-stdout): Don't use
Eli Zaretskii <eliz@gnu.org>
parents:
20767
diff
changeset
|
1079 (car command) |
e21c343b0c6e
(archive-extract-by-stdout): Don't use
Eli Zaretskii <eliz@gnu.org>
parents:
20767
diff
changeset
|
1080 nil |
e21c343b0c6e
(archive-extract-by-stdout): Don't use
Eli Zaretskii <eliz@gnu.org>
parents:
20767
diff
changeset
|
1081 nil |
e21c343b0c6e
(archive-extract-by-stdout): Don't use
Eli Zaretskii <eliz@gnu.org>
parents:
20767
diff
changeset
|
1082 nil |
e21c343b0c6e
(archive-extract-by-stdout): Don't use
Eli Zaretskii <eliz@gnu.org>
parents:
20767
diff
changeset
|
1083 (append (cdr command) (list archive name)))) |
94986
e2f05c17ddad
(archive-add-new-member): Use `derived-mode-p'.
John Paul Wallington <jpw@pobox.com>
parents:
94678
diff
changeset
|
1084 (cond ((and (numberp exit-status) (zerop exit-status)) |
21570
e21c343b0c6e
(archive-extract-by-stdout): Don't use
Eli Zaretskii <eliz@gnu.org>
parents:
20767
diff
changeset
|
1085 (if (not (file-exists-p tmpfile)) |
e21c343b0c6e
(archive-extract-by-stdout): Don't use
Eli Zaretskii <eliz@gnu.org>
parents:
20767
diff
changeset
|
1086 (ding (message "`%s': no such file or directory" tmpfile)) |
e21c343b0c6e
(archive-extract-by-stdout): Don't use
Eli Zaretskii <eliz@gnu.org>
parents:
20767
diff
changeset
|
1087 (insert-file-contents tmpfile) |
e21c343b0c6e
(archive-extract-by-stdout): Don't use
Eli Zaretskii <eliz@gnu.org>
parents:
20767
diff
changeset
|
1088 (setq success t))) |
e21c343b0c6e
(archive-extract-by-stdout): Don't use
Eli Zaretskii <eliz@gnu.org>
parents:
20767
diff
changeset
|
1089 ((numberp exit-status) |
e21c343b0c6e
(archive-extract-by-stdout): Don't use
Eli Zaretskii <eliz@gnu.org>
parents:
20767
diff
changeset
|
1090 (ding |
e21c343b0c6e
(archive-extract-by-stdout): Don't use
Eli Zaretskii <eliz@gnu.org>
parents:
20767
diff
changeset
|
1091 (message "`%s' exited with status %d" (car command) exit-status))) |
e21c343b0c6e
(archive-extract-by-stdout): Don't use
Eli Zaretskii <eliz@gnu.org>
parents:
20767
diff
changeset
|
1092 ((stringp exit-status) |
e21c343b0c6e
(archive-extract-by-stdout): Don't use
Eli Zaretskii <eliz@gnu.org>
parents:
20767
diff
changeset
|
1093 (ding (message "`%s' aborted: %s" (car command) exit-status))) |
e21c343b0c6e
(archive-extract-by-stdout): Don't use
Eli Zaretskii <eliz@gnu.org>
parents:
20767
diff
changeset
|
1094 (t |
e21c343b0c6e
(archive-extract-by-stdout): Don't use
Eli Zaretskii <eliz@gnu.org>
parents:
20767
diff
changeset
|
1095 (ding (message "`%s' failed" (car command))))) |
e21c343b0c6e
(archive-extract-by-stdout): Don't use
Eli Zaretskii <eliz@gnu.org>
parents:
20767
diff
changeset
|
1096 (archive-delete-local tmpfile) |
e21c343b0c6e
(archive-extract-by-stdout): Don't use
Eli Zaretskii <eliz@gnu.org>
parents:
20767
diff
changeset
|
1097 success)) |
11880 | 1098 |
107896
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
1099 (defun archive-extract-by-stdout (archive name command &optional stderr-file) |
22830
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
1100 (apply 'call-process |
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
1101 (car command) |
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
1102 nil |
107896
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
1103 (if stderr-file (list t stderr-file) t) |
22830
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
1104 nil |
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
1105 (append (cdr command) (list archive name)))) |
11880 | 1106 |
1107 (defun archive-extract-other-window () | |
1108 "In archive mode, find this member in another window." | |
1109 (interactive) | |
1110 (archive-extract t)) | |
1111 | |
1112 (defun archive-display-other-window () | |
1113 "In archive mode, display this member in another window." | |
1114 (interactive) | |
1115 (archive-extract 'display)) | |
1116 | |
1117 (defun archive-view () | |
1118 "In archive mode, view the member on this line." | |
1119 (interactive) | |
1120 (archive-extract 'view)) | |
1121 | |
1122 (defun archive-add-new-member (arcbuf name) | |
12791
61bbb487bf2c
Standardize layout of doc strings.
Richard M. Stallman <rms@gnu.org>
parents:
12756
diff
changeset
|
1123 "Add current buffer to the archive in ARCBUF naming it NAME." |
11880 | 1124 (interactive |
1125 (list (get-buffer | |
1126 (read-buffer "Buffer containing archive: " | |
1127 ;; Find first archive buffer and suggest that | |
1128 (let ((bufs (buffer-list))) | |
63889
abe14daaa679
Bind inhibit-read-only rather than buffer-read-only.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
62714
diff
changeset
|
1129 (while (and bufs |
abe14daaa679
Bind inhibit-read-only rather than buffer-read-only.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
62714
diff
changeset
|
1130 (not (with-current-buffer (car bufs) |
abe14daaa679
Bind inhibit-read-only rather than buffer-read-only.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
62714
diff
changeset
|
1131 (derived-mode-p 'archive-mode)))) |
abe14daaa679
Bind inhibit-read-only rather than buffer-read-only.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
62714
diff
changeset
|
1132 (setq bufs (cdr bufs))) |
11880 | 1133 (if bufs |
1134 (car bufs) | |
1135 (error "There are no archive buffers"))) | |
1136 t)) | |
1137 (read-string "File name in archive: " | |
1138 (if buffer-file-name | |
1139 (file-name-nondirectory buffer-file-name) | |
1140 "")))) | |
63889
abe14daaa679
Bind inhibit-read-only rather than buffer-read-only.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
62714
diff
changeset
|
1141 (with-current-buffer arcbuf |
94986
e2f05c17ddad
(archive-add-new-member): Use `derived-mode-p'.
John Paul Wallington <jpw@pobox.com>
parents:
94678
diff
changeset
|
1142 (or (derived-mode-p 'archive-mode) |
11880 | 1143 (error "Buffer is not an archive buffer")) |
1144 (if archive-read-only | |
1145 (error "Archive is read-only"))) | |
1146 (if (eq arcbuf (current-buffer)) | |
1147 (error "An archive buffer cannot be added to itself")) | |
1148 (if (string= name "") | |
1149 (error "Archive members may not be given empty names")) | |
63889
abe14daaa679
Bind inhibit-read-only rather than buffer-read-only.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
62714
diff
changeset
|
1150 (let ((func (with-current-buffer arcbuf |
abe14daaa679
Bind inhibit-read-only rather than buffer-read-only.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
62714
diff
changeset
|
1151 (archive-name "add-new-member"))) |
11880 | 1152 (membuf (current-buffer))) |
1153 (if (fboundp func) | |
63889
abe14daaa679
Bind inhibit-read-only rather than buffer-read-only.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
62714
diff
changeset
|
1154 (with-current-buffer arcbuf |
11880 | 1155 (funcall func buffer-file-name membuf name)) |
1156 (error "Adding a new member is not supported for this archive type")))) | |
1157 ;; ------------------------------------------------------------------------- | |
84661
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1158 ;;; Section: IO stuff |
11880 | 1159 |
1160 (defun archive-write-file-member () | |
21570
e21c343b0c6e
(archive-extract-by-stdout): Don't use
Eli Zaretskii <eliz@gnu.org>
parents:
20767
diff
changeset
|
1161 (save-excursion |
e21c343b0c6e
(archive-extract-by-stdout): Don't use
Eli Zaretskii <eliz@gnu.org>
parents:
20767
diff
changeset
|
1162 (save-restriction |
e21c343b0c6e
(archive-extract-by-stdout): Don't use
Eli Zaretskii <eliz@gnu.org>
parents:
20767
diff
changeset
|
1163 (message "Updating archive...") |
e21c343b0c6e
(archive-extract-by-stdout): Don't use
Eli Zaretskii <eliz@gnu.org>
parents:
20767
diff
changeset
|
1164 (widen) |
63889
abe14daaa679
Bind inhibit-read-only rather than buffer-read-only.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
62714
diff
changeset
|
1165 (let ((writer (with-current-buffer archive-superior-buffer |
abe14daaa679
Bind inhibit-read-only rather than buffer-read-only.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
62714
diff
changeset
|
1166 (archive-name "write-file-member"))) |
abe14daaa679
Bind inhibit-read-only rather than buffer-read-only.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
62714
diff
changeset
|
1167 (archive (with-current-buffer archive-superior-buffer |
abe14daaa679
Bind inhibit-read-only rather than buffer-read-only.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
62714
diff
changeset
|
1168 (archive-maybe-copy (buffer-file-name))))) |
21570
e21c343b0c6e
(archive-extract-by-stdout): Don't use
Eli Zaretskii <eliz@gnu.org>
parents:
20767
diff
changeset
|
1169 (if (fboundp writer) |
e21c343b0c6e
(archive-extract-by-stdout): Don't use
Eli Zaretskii <eliz@gnu.org>
parents:
20767
diff
changeset
|
1170 (funcall writer archive archive-subfile-mode) |
e21c343b0c6e
(archive-extract-by-stdout): Don't use
Eli Zaretskii <eliz@gnu.org>
parents:
20767
diff
changeset
|
1171 (archive-*-write-file-member archive |
e21c343b0c6e
(archive-extract-by-stdout): Don't use
Eli Zaretskii <eliz@gnu.org>
parents:
20767
diff
changeset
|
1172 archive-subfile-mode |
22062
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
1173 (symbol-value writer))) |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
1174 (set-buffer-modified-p nil) |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
1175 (message "Updating archive...done")) |
21570
e21c343b0c6e
(archive-extract-by-stdout): Don't use
Eli Zaretskii <eliz@gnu.org>
parents:
20767
diff
changeset
|
1176 (set-buffer archive-superior-buffer) |
22062
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
1177 (if (not archive-remote) (revert-buffer) (archive-maybe-update nil)))) |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
1178 ;; Restore the value of last-coding-system-used, so that basic-save-buffer |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
1179 ;; won't reset the coding-system of this archive member. |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
1180 (if (local-variable-p 'archive-member-coding-system) |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
1181 (setq last-coding-system-used archive-member-coding-system)) |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
1182 t) |
11880 | 1183 |
1184 (defun archive-*-write-file-member (archive descr command) | |
1185 (let* ((ename (aref descr 0)) | |
1186 (tmpfile (expand-file-name ename archive-tmpdir)) | |
1187 (top (directory-file-name (file-name-as-directory archive-tmpdir))) | |
1188 (default-directory (file-name-as-directory top))) | |
1189 (unwind-protect | |
1190 (progn | |
1191 (make-directory (file-name-directory tmpfile) t) | |
22062
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
1192 ;; If the member is itself an archive, write it without |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
1193 ;; the dired-like listing we created. |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
1194 (if (eq major-mode 'archive-mode) |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
1195 (archive-write-file tmpfile) |
95366
52e3cee99f90
* progmodes/flymake.el (flymake-save-buffer-in-file):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94986
diff
changeset
|
1196 (write-region nil nil tmpfile nil 'nomessage)) |
22062
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
1197 ;; basic-save-buffer needs last-coding-system-used to have |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
1198 ;; the value used to write the file, so save it before any |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
1199 ;; further processing clobbers it (we restore it in |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
1200 ;; archive-write-file-member, above). |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
1201 (setq archive-member-coding-system last-coding-system-used) |
11880 | 1202 (if (aref descr 3) |
1203 ;; Set the file modes, but make sure we can read it. | |
1204 (set-file-modes tmpfile (logior ?\400 (aref descr 3)))) | |
88954
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
1205 (setq ename |
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
1206 (encode-coding-string ename archive-file-name-coding-system)) |
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
1207 (let* ((coding-system-for-write 'no-conversion) |
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
1208 (exitcode (apply 'call-process |
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
1209 (car command) |
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
1210 nil |
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
1211 nil |
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
1212 nil |
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
1213 (append (cdr command) |
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
1214 (list archive ename))))) |
94986
e2f05c17ddad
(archive-add-new-member): Use `derived-mode-p'.
John Paul Wallington <jpw@pobox.com>
parents:
94678
diff
changeset
|
1215 (or (zerop exitcode) |
e2f05c17ddad
(archive-add-new-member): Use `derived-mode-p'.
John Paul Wallington <jpw@pobox.com>
parents:
94678
diff
changeset
|
1216 (error "Updating was unsuccessful (%S)" exitcode)))) |
11880 | 1217 (archive-delete-local tmpfile)))) |
1218 | |
22062
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
1219 (defun archive-write-file (&optional file) |
11880 | 1220 (save-excursion |
22062
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
1221 (let ((coding-system-for-write 'no-conversion)) |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
1222 (write-region archive-proper-file-start (point-max) |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
1223 (or file buffer-file-name) nil t) |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
1224 (set-buffer-modified-p nil)) |
11880 | 1225 t)) |
1226 ;; ------------------------------------------------------------------------- | |
84661
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1227 ;;; Section: Marking and unmarking. |
11880 | 1228 |
1229 (defun archive-flag-deleted (p &optional type) | |
1230 "In archive mode, mark this member to be deleted from the archive. | |
1231 With a prefix argument, mark that many files." | |
1232 (interactive "p") | |
1233 (or type (setq type ?D)) | |
1234 (beginning-of-line) | |
1235 (let ((sign (if (>= p 0) +1 -1)) | |
1236 (modified (buffer-modified-p)) | |
63889
abe14daaa679
Bind inhibit-read-only rather than buffer-read-only.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
62714
diff
changeset
|
1237 (inhibit-read-only t)) |
11880 | 1238 (while (not (zerop p)) |
1239 (if (archive-get-descr t) | |
1240 (progn | |
1241 (delete-char 1) | |
1242 (insert type))) | |
1243 (forward-line sign) | |
1244 (setq p (- p sign))) | |
63889
abe14daaa679
Bind inhibit-read-only rather than buffer-read-only.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
62714
diff
changeset
|
1245 (restore-buffer-modified-p modified)) |
11880 | 1246 (archive-next-line 0)) |
1247 | |
1248 (defun archive-unflag (p) | |
1249 "In archive mode, un-mark this member if it is marked to be deleted. | |
1250 With a prefix argument, un-mark that many files forward." | |
1251 (interactive "p") | |
64528
54d2ccd509bc
(archive-get-descr, archive-alternate-display): Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
64091
diff
changeset
|
1252 (archive-flag-deleted p ?\s)) |
11880 | 1253 |
1254 (defun archive-unflag-backwards (p) | |
1255 "In archive mode, un-mark this member if it is marked to be deleted. | |
1256 With a prefix argument, un-mark that many members backward." | |
1257 (interactive "p") | |
64528
54d2ccd509bc
(archive-get-descr, archive-alternate-display): Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
64091
diff
changeset
|
1258 (archive-flag-deleted (- p) ?\s)) |
11880 | 1259 |
1260 (defun archive-unmark-all-files () | |
1261 "Remove all marks." | |
1262 (interactive) | |
1263 (let ((modified (buffer-modified-p)) | |
63889
abe14daaa679
Bind inhibit-read-only rather than buffer-read-only.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
62714
diff
changeset
|
1264 (inhibit-read-only t)) |
11880 | 1265 (save-excursion |
1266 (goto-char archive-file-list-start) | |
1267 (while (< (point) archive-file-list-end) | |
64528
54d2ccd509bc
(archive-get-descr, archive-alternate-display): Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
64091
diff
changeset
|
1268 (or (= (following-char) ?\s) |
54d2ccd509bc
(archive-get-descr, archive-alternate-display): Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
64091
diff
changeset
|
1269 (progn (delete-char 1) (insert ?\s))) |
11880 | 1270 (forward-line 1))) |
63889
abe14daaa679
Bind inhibit-read-only rather than buffer-read-only.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
62714
diff
changeset
|
1271 (restore-buffer-modified-p modified))) |
11880 | 1272 |
1273 (defun archive-mark (p) | |
1274 "In archive mode, mark this member for group operations. | |
1275 With a prefix argument, mark that many members. | |
1276 Use \\[archive-unmark-all-files] to remove all marks." | |
1277 (interactive "p") | |
1278 (archive-flag-deleted p ?*)) | |
1279 | |
1280 (defun archive-get-marked (mark &optional default) | |
1281 (let (files) | |
1282 (save-excursion | |
1283 (goto-char archive-file-list-start) | |
1284 (while (< (point) archive-file-list-end) | |
1285 (if (= (following-char) mark) | |
1286 (setq files (cons (archive-get-descr) files))) | |
1287 (forward-line 1))) | |
1288 (or (nreverse files) | |
1289 (and default | |
1290 (list (archive-get-descr)))))) | |
1291 ;; ------------------------------------------------------------------------- | |
84661
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1292 ;;; Section: Operate |
11880 | 1293 |
1294 (defun archive-next-line (p) | |
1295 (interactive "p") | |
1296 (forward-line p) | |
1297 (or (eobp) | |
1298 (forward-char archive-file-name-indent))) | |
1299 | |
1300 (defun archive-previous-line (p) | |
1301 (interactive "p") | |
1302 (archive-next-line (- p))) | |
1303 | |
1304 (defun archive-chmod-entry (new-mode) | |
12791
61bbb487bf2c
Standardize layout of doc strings.
Richard M. Stallman <rms@gnu.org>
parents:
12756
diff
changeset
|
1305 "Change the protection bits associated with all marked or this member. |
11880 | 1306 The new protection bits can either be specified as an octal number or |
64528
54d2ccd509bc
(archive-get-descr, archive-alternate-display): Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
64091
diff
changeset
|
1307 as a relative change like \"g+rw\" as for chmod(2)." |
11880 | 1308 (interactive "sNew mode (octal or relative): ") |
1309 (if archive-read-only (error "Archive is read-only")) | |
1310 (let ((func (archive-name "chmod-entry"))) | |
1311 (if (fboundp func) | |
1312 (progn | |
1313 (funcall func new-mode (archive-get-marked ?* t)) | |
1314 (archive-resummarize)) | |
1315 (error "Setting mode bits is not supported for this archive type")))) | |
1316 | |
1317 (defun archive-chown-entry (new-uid) | |
1318 "Change the owner of all marked or this member." | |
1319 (interactive "nNew uid: ") | |
1320 (if archive-read-only (error "Archive is read-only")) | |
1321 (let ((func (archive-name "chown-entry"))) | |
1322 (if (fboundp func) | |
1323 (progn | |
1324 (funcall func new-uid (archive-get-marked ?* t)) | |
1325 (archive-resummarize)) | |
1326 (error "Setting owner is not supported for this archive type")))) | |
1327 | |
1328 (defun archive-chgrp-entry (new-gid) | |
1329 "Change the group of all marked or this member." | |
1330 (interactive "nNew gid: ") | |
1331 (if archive-read-only (error "Archive is read-only")) | |
1332 (let ((func (archive-name "chgrp-entry"))) | |
1333 (if (fboundp func) | |
1334 (progn | |
1335 (funcall func new-gid (archive-get-marked ?* t)) | |
1336 (archive-resummarize)) | |
1337 (error "Setting group is not supported for this archive type")))) | |
1338 | |
1339 (defun archive-expunge () | |
1340 "Do the flagged deletions." | |
1341 (interactive) | |
1342 (let (files) | |
1343 (save-excursion | |
1344 (goto-char archive-file-list-start) | |
1345 (while (< (point) archive-file-list-end) | |
1346 (if (= (following-char) ?D) | |
1347 (setq files (cons (aref (archive-get-descr) 0) files))) | |
1348 (forward-line 1))) | |
1349 (setq files (nreverse files)) | |
1350 (and files | |
1351 (or (not archive-read-only) | |
1352 (error "Archive is read-only")) | |
1353 (or (yes-or-no-p (format "Really delete %d member%s? " | |
1354 (length files) | |
1355 (if (null (cdr files)) "" "s"))) | |
1356 (error "Operation aborted")) | |
1357 (let ((archive (archive-maybe-copy (buffer-file-name))) | |
1358 (expunger (archive-name "expunge"))) | |
1359 (if (fboundp expunger) | |
1360 (funcall expunger archive files) | |
1361 (archive-*-expunge archive files (symbol-value expunger))) | |
1362 (archive-maybe-update nil) | |
1363 (if archive-remote | |
1364 (archive-resummarize) | |
1365 (revert-buffer)))))) | |
1366 | |
1367 (defun archive-*-expunge (archive files command) | |
1368 (apply 'call-process | |
1369 (car command) | |
1370 nil | |
1371 nil | |
1372 nil | |
1373 (append (cdr command) (cons archive files)))) | |
1374 | |
1375 (defun archive-rename-entry (newname) | |
63891
d7d21c20c225
(archive-extract): Make it work as a mouse binding.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
63889
diff
changeset
|
1376 "Change the name associated with this entry in the archive file." |
11880 | 1377 (interactive "sNew name: ") |
1378 (if archive-read-only (error "Archive is read-only")) | |
1379 (if (string= newname "") | |
1380 (error "Archive members may not be given empty names")) | |
1381 (let ((func (archive-name "rename-entry")) | |
1382 (descr (archive-get-descr))) | |
1383 (if (fboundp func) | |
1384 (progn | |
63891
d7d21c20c225
(archive-extract): Make it work as a mouse binding.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
63889
diff
changeset
|
1385 (funcall func |
88954
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
1386 (encode-coding-string newname |
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
1387 archive-file-name-coding-system) |
22830
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
1388 descr) |
11880 | 1389 (archive-resummarize)) |
1390 (error "Renaming is not supported for this archive type")))) | |
1391 | |
1392 ;; Revert the buffer and recompute the dired-like listing. | |
23383
7af3fdca3189
(archive-mode-revert): Arg no-auto-save renamed from no-autosave.
Karl Heuer <kwzh@gnu.org>
parents:
22834
diff
changeset
|
1393 (defun archive-mode-revert (&optional no-auto-save no-confirm) |
11880 | 1394 (let ((no (archive-get-lineno))) |
1395 (setq archive-files nil) | |
22062
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
1396 (let ((revert-buffer-function nil) |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
1397 (coding-system-for-read 'no-conversion)) |
11880 | 1398 (revert-buffer t t)) |
1399 (archive-mode) | |
1400 (goto-char archive-file-list-start) | |
1401 (archive-next-line no))) | |
1402 | |
1403 (defun archive-undo () | |
1404 "Undo in an archive buffer. | |
1405 This doesn't recover lost files, it just undoes changes in the buffer itself." | |
1406 (interactive) | |
63889
abe14daaa679
Bind inhibit-read-only rather than buffer-read-only.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
62714
diff
changeset
|
1407 (let ((inhibit-read-only t)) |
11880 | 1408 (undo))) |
1409 ;; ------------------------------------------------------------------------- | |
84661
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1410 ;;; Section: Arc Archives |
11880 | 1411 |
1412 (defun archive-arc-summarize () | |
1413 (let ((p 1) | |
1414 (totalsize 0) | |
1415 (maxlen 8) | |
1416 files | |
1417 visual) | |
1418 (while (and (< (+ p 29) (point-max)) | |
88954
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
1419 (= (byte-after p) ?\C-z) |
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
1420 (> (byte-after (1+ p)) 0)) |
11880 | 1421 (let* ((namefld (buffer-substring (+ p 2) (+ p 2 13))) |
1422 (fnlen (or (string-match "\0" namefld) 13)) | |
88954
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
1423 (efnname (decode-coding-string (substring namefld 0 fnlen) |
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
1424 archive-file-name-coding-system)) |
70388
000b130bfb7d
(archive-l-e): New optional argument `float' means generate a float value.
Eli Zaretskii <eliz@gnu.org>
parents:
69331
diff
changeset
|
1425 ;; Convert to float to avoid overflow for very large files. |
000b130bfb7d
(archive-l-e): New optional argument `float' means generate a float value.
Eli Zaretskii <eliz@gnu.org>
parents:
69331
diff
changeset
|
1426 (csize (archive-l-e (+ p 15) 4 'float)) |
11880 | 1427 (moddate (archive-l-e (+ p 19) 2)) |
1428 (modtime (archive-l-e (+ p 21) 2)) | |
70388
000b130bfb7d
(archive-l-e): New optional argument `float' means generate a float value.
Eli Zaretskii <eliz@gnu.org>
parents:
69331
diff
changeset
|
1429 (ucsize (archive-l-e (+ p 25) 4 'float)) |
11880 | 1430 (fiddle (string= efnname (upcase efnname))) |
1431 (ifnname (if fiddle (downcase efnname) efnname)) | |
70388
000b130bfb7d
(archive-l-e): New optional argument `float' means generate a float value.
Eli Zaretskii <eliz@gnu.org>
parents:
69331
diff
changeset
|
1432 (text (format " %8.0f %-11s %-8s %s" |
11880 | 1433 ucsize |
1434 (archive-dosdate moddate) | |
1435 (archive-dostime modtime) | |
1436 ifnname))) | |
1437 (setq maxlen (max maxlen fnlen) | |
1438 totalsize (+ totalsize ucsize) | |
1439 visual (cons (vector text | |
1440 (- (length text) (length ifnname)) | |
1441 (length text)) | |
1442 visual) | |
1443 files (cons (vector efnname ifnname fiddle nil (1- p)) | |
1444 files) | |
70679
ff708eaf43ab
(archive-arc-summarize, archive-lzh-summarize): Convert csize to integer when
Eli Zaretskii <eliz@gnu.org>
parents:
70544
diff
changeset
|
1445 ;; p needs to stay an integer, since we use it in char-after |
ff708eaf43ab
(archive-arc-summarize, archive-lzh-summarize): Convert csize to integer when
Eli Zaretskii <eliz@gnu.org>
parents:
70544
diff
changeset
|
1446 ;; above. Passing through `round' limits the compressed size |
ff708eaf43ab
(archive-arc-summarize, archive-lzh-summarize): Convert csize to integer when
Eli Zaretskii <eliz@gnu.org>
parents:
70544
diff
changeset
|
1447 ;; to most-positive-fixnum, but if the compressed size exceeds |
ff708eaf43ab
(archive-arc-summarize, archive-lzh-summarize): Convert csize to integer when
Eli Zaretskii <eliz@gnu.org>
parents:
70544
diff
changeset
|
1448 ;; that, we cannot visit the archive anyway. |
ff708eaf43ab
(archive-arc-summarize, archive-lzh-summarize): Convert csize to integer when
Eli Zaretskii <eliz@gnu.org>
parents:
70544
diff
changeset
|
1449 p (+ p 29 (round csize))))) |
11880 | 1450 (goto-char (point-min)) |
1451 (let ((dash (concat "- -------- ----------- -------- " | |
1452 (make-string maxlen ?-) | |
1453 "\n"))) | |
1454 (insert "M Length Date Time File\n" | |
1455 dash) | |
1456 (archive-summarize-files (nreverse visual)) | |
1457 (insert dash | |
70388
000b130bfb7d
(archive-l-e): New optional argument `float' means generate a float value.
Eli Zaretskii <eliz@gnu.org>
parents:
69331
diff
changeset
|
1458 (format " %8.0f %d file%s" |
11880 | 1459 totalsize |
1460 (length files) | |
1461 (if (= 1 (length files)) "" "s")) | |
1462 "\n")) | |
1463 (apply 'vector (nreverse files)))) | |
1464 | |
63891
d7d21c20c225
(archive-extract): Make it work as a mouse binding.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
63889
diff
changeset
|
1465 (defun archive-arc-rename-entry (newname descr) |
11880 | 1466 (if (string-match "[:\\\\/]" newname) |
49238
86973b914660
(archive-arc-rename-entry): Fix error message.
Kim F. Storm <storm@cua.dk>
parents:
49166
diff
changeset
|
1467 (error "File names in arc files must not contain a directory component")) |
11880 | 1468 (if (> (length newname) 12) |
1469 (error "File names in arc files are limited to 12 characters")) | |
1470 (let ((name (concat newname (substring "\0\0\0\0\0\0\0\0\0\0\0\0\0" | |
1471 (length newname)))) | |
63889
abe14daaa679
Bind inhibit-read-only rather than buffer-read-only.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
62714
diff
changeset
|
1472 (inhibit-read-only t)) |
11880 | 1473 (save-restriction |
1474 (save-excursion | |
1475 (widen) | |
1476 (goto-char (+ archive-proper-file-start (aref descr 4) 2)) | |
1477 (delete-char 13) | |
88954
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
1478 (insert-unibyte name))))) |
11880 | 1479 ;; ------------------------------------------------------------------------- |
84661
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1480 ;;; Section: Lzh Archives |
11880 | 1481 |
77330
1b3aff56da73
(archive-find-type): lzh-exe for lzh self-extracting exe.
Chong Yidong <cyd@stupidchicken.com>
parents:
77274
diff
changeset
|
1482 (defun archive-lzh-summarize (&optional start) |
1b3aff56da73
(archive-find-type): lzh-exe for lzh self-extracting exe.
Chong Yidong <cyd@stupidchicken.com>
parents:
77274
diff
changeset
|
1483 (let ((p (or start 1)) ;; 1 for .lzh, something further on for .exe |
11880 | 1484 (totalsize 0) |
1485 (maxlen 8) | |
1486 files | |
1487 visual) | |
49437
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1488 (while (progn (goto-char p) ;beginning of a base header. |
20767
ad6c6f1bd674
(archive-find-type): Accept d or s after digit, for lzh.
Richard M. Stallman <rms@gnu.org>
parents:
20239
diff
changeset
|
1489 (looking-at "\\(.\\|\n\\)\\(.\\|\n\\)-l[hz][0-9ds]-")) |
89483 | 1490 (let* ((hsize (byte-after p)) ;size of the base header (level 0 and 1) |
70388
000b130bfb7d
(archive-l-e): New optional argument `float' means generate a float value.
Eli Zaretskii <eliz@gnu.org>
parents:
69331
diff
changeset
|
1491 ;; Convert to float to avoid overflow for very large files. |
000b130bfb7d
(archive-l-e): New optional argument `float' means generate a float value.
Eli Zaretskii <eliz@gnu.org>
parents:
69331
diff
changeset
|
1492 (csize (archive-l-e (+ p 7) 4 'float)) ;size of a compressed file to follow (level 0 and 2), |
51158
00d0f607793b
(archive-lzh-summarize): Calculate correct total
Richard M. Stallman <rms@gnu.org>
parents:
50835
diff
changeset
|
1493 ;size of extended headers + the compressed file to follow (level 1). |
70388
000b130bfb7d
(archive-l-e): New optional argument `float' means generate a float value.
Eli Zaretskii <eliz@gnu.org>
parents:
69331
diff
changeset
|
1494 (ucsize (archive-l-e (+ p 11) 4 'float)) ;size of an uncompressed file. |
49437
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1495 (time1 (archive-l-e (+ p 15) 2)) ;date/time (MSDOS format in level 0, 1 headers |
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1496 (time2 (archive-l-e (+ p 17) 2)) ;and UNIX format in level 2 header.) |
89483 | 1497 (hdrlvl (byte-after (+ p 20))) ;header level |
49437
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1498 thsize ;total header size (base + extensions) |
77274
d966323ac214
(archive-lzh-summarize): Only apply the "downcase if all upcase" rule
Chong Yidong <cyd@stupidchicken.com>
parents:
75347
diff
changeset
|
1499 fnlen efnname osid fiddle ifnname width p2 |
49437
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1500 neh ;beginning of next extension header (level 1 and 2) |
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1501 mode modestr uid gid text dir prname |
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1502 gname uname modtime moddate) |
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1503 (if (= hdrlvl 3) (error "can't handle lzh level 3 header type")) |
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1504 (when (or (= hdrlvl 0) (= hdrlvl 1)) |
89483 | 1505 (setq fnlen (byte-after (+ p 21))) ;filename length |
49437
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1506 (setq efnname (let ((str (buffer-substring (+ p 22) (+ p 22 fnlen)))) ;filename from offset 22 |
88954
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
1507 (decode-coding-string |
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
1508 str archive-file-name-coding-system))) |
49437
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1509 (setq p2 (+ p 22 fnlen))) ; |
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1510 (if (= hdrlvl 1) |
63891
d7d21c20c225
(archive-extract): Make it work as a mouse binding.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
63889
diff
changeset
|
1511 (setq neh (+ p2 3)) ;specific to level 1 header |
49437
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1512 (if (= hdrlvl 2) |
63891
d7d21c20c225
(archive-extract): Make it work as a mouse binding.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
63889
diff
changeset
|
1513 (setq neh (+ p 24)))) ;specific to level 2 header |
49437
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1514 (if neh ;if level 1 or 2 we expect extension headers to follow |
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1515 (let* ((ehsize (archive-l-e neh 2)) ;size of the extension header |
89483 | 1516 (etype (byte-after (+ neh 2)))) ;extension type |
49437
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1517 (while (not (= ehsize 0)) |
20767
ad6c6f1bd674
(archive-find-type): Accept d or s after digit, for lzh.
Richard M. Stallman <rms@gnu.org>
parents:
20239
diff
changeset
|
1518 (cond |
49437
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1519 ((= etype 1) ;file name |
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1520 (let ((i (+ neh 3))) |
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1521 (while (< i (+ neh ehsize)) |
89483 | 1522 (setq efnname (concat efnname (char-to-string (byte-after i)))) |
49437
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1523 (setq i (1+ i))))) |
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1524 ((= etype 2) ;directory name |
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1525 (let ((i (+ neh 3))) |
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1526 (while (< i (+ neh ehsize)) |
49238
86973b914660
(archive-arc-rename-entry): Fix error message.
Kim F. Storm <storm@cua.dk>
parents:
49166
diff
changeset
|
1527 (setq dir (concat dir |
88954
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
1528 (if (= (byte-after i) |
20767
ad6c6f1bd674
(archive-find-type): Accept d or s after digit, for lzh.
Richard M. Stallman <rms@gnu.org>
parents:
20239
diff
changeset
|
1529 255) |
ad6c6f1bd674
(archive-find-type): Accept d or s after digit, for lzh.
Richard M. Stallman <rms@gnu.org>
parents:
20239
diff
changeset
|
1530 "/" |
ad6c6f1bd674
(archive-find-type): Accept d or s after digit, for lzh.
Richard M. Stallman <rms@gnu.org>
parents:
20239
diff
changeset
|
1531 (char-to-string |
ad6c6f1bd674
(archive-find-type): Accept d or s after digit, for lzh.
Richard M. Stallman <rms@gnu.org>
parents:
20239
diff
changeset
|
1532 (char-after i))))) |
ad6c6f1bd674
(archive-find-type): Accept d or s after digit, for lzh.
Richard M. Stallman <rms@gnu.org>
parents:
20239
diff
changeset
|
1533 (setq i (1+ i))))) |
49437
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1534 ((= etype 80) ;Unix file permission |
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1535 (setq mode (archive-l-e (+ neh 3) 2))) |
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1536 ((= etype 81) ;UNIX file group/user ID |
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1537 (progn (setq uid (archive-l-e (+ neh 3) 2)) |
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1538 (setq gid (archive-l-e (+ neh 5) 2)))) |
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1539 ((= etype 82) ;UNIX file group name |
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1540 (let ((i (+ neh 3))) |
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1541 (while (< i (+ neh ehsize)) |
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1542 (setq gname (concat gname (char-to-string (char-after i)))) |
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1543 (setq i (1+ i))))) |
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1544 ((= etype 83) ;UNIX file user name |
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1545 (let ((i (+ neh 3))) |
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1546 (while (< i (+ neh ehsize)) |
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1547 (setq uname (concat uname (char-to-string (char-after i)))) |
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1548 (setq i (1+ i))))) |
20767
ad6c6f1bd674
(archive-find-type): Accept d or s after digit, for lzh.
Richard M. Stallman <rms@gnu.org>
parents:
20239
diff
changeset
|
1549 ) |
49437
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1550 (setq neh (+ neh ehsize)) |
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1551 (setq ehsize (archive-l-e neh 2)) |
89483 | 1552 (setq etype (byte-after (+ neh 2)))) |
49437
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1553 ;;get total header size for level 1 and 2 headers |
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1554 (setq thsize (- neh p)))) |
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1555 (if (= hdrlvl 0) ;total header size |
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1556 (setq thsize hsize)) |
77274
d966323ac214
(archive-lzh-summarize): Only apply the "downcase if all upcase" rule
Chong Yidong <cyd@stupidchicken.com>
parents:
75347
diff
changeset
|
1557 ;; OS ID field not present in level 0 header, use code 0 "generic" |
d966323ac214
(archive-lzh-summarize): Only apply the "downcase if all upcase" rule
Chong Yidong <cyd@stupidchicken.com>
parents:
75347
diff
changeset
|
1558 ;; in that case as per lha program header.c get_header() |
d966323ac214
(archive-lzh-summarize): Only apply the "downcase if all upcase" rule
Chong Yidong <cyd@stupidchicken.com>
parents:
75347
diff
changeset
|
1559 (setq osid (cond ((= hdrlvl 0) 0) |
d966323ac214
(archive-lzh-summarize): Only apply the "downcase if all upcase" rule
Chong Yidong <cyd@stupidchicken.com>
parents:
75347
diff
changeset
|
1560 ((= hdrlvl 1) (char-after (+ p 22 fnlen 2))) |
d966323ac214
(archive-lzh-summarize): Only apply the "downcase if all upcase" rule
Chong Yidong <cyd@stupidchicken.com>
parents:
75347
diff
changeset
|
1561 ((= hdrlvl 2) (char-after (+ p 23))))) |
d966323ac214
(archive-lzh-summarize): Only apply the "downcase if all upcase" rule
Chong Yidong <cyd@stupidchicken.com>
parents:
75347
diff
changeset
|
1562 ;; Filename fiddling must follow the lha program, otherwise the name |
d966323ac214
(archive-lzh-summarize): Only apply the "downcase if all upcase" rule
Chong Yidong <cyd@stupidchicken.com>
parents:
75347
diff
changeset
|
1563 ;; passed to "lha pq" etc won't match (which for an extract silently |
d966323ac214
(archive-lzh-summarize): Only apply the "downcase if all upcase" rule
Chong Yidong <cyd@stupidchicken.com>
parents:
75347
diff
changeset
|
1564 ;; results in no output). As of version 1.14i it goes from the OS ID, |
d966323ac214
(archive-lzh-summarize): Only apply the "downcase if all upcase" rule
Chong Yidong <cyd@stupidchicken.com>
parents:
75347
diff
changeset
|
1565 ;; - For 'M' MSDOS: msdos_to_unix_filename() downcases always, and |
d966323ac214
(archive-lzh-summarize): Only apply the "downcase if all upcase" rule
Chong Yidong <cyd@stupidchicken.com>
parents:
75347
diff
changeset
|
1566 ;; converts "\" to "/". |
d966323ac214
(archive-lzh-summarize): Only apply the "downcase if all upcase" rule
Chong Yidong <cyd@stupidchicken.com>
parents:
75347
diff
changeset
|
1567 ;; - For 0 generic: generic_to_unix_filename() downcases if there's |
d966323ac214
(archive-lzh-summarize): Only apply the "downcase if all upcase" rule
Chong Yidong <cyd@stupidchicken.com>
parents:
75347
diff
changeset
|
1568 ;; no lower case already present, and converts "\" to "/". |
d966323ac214
(archive-lzh-summarize): Only apply the "downcase if all upcase" rule
Chong Yidong <cyd@stupidchicken.com>
parents:
75347
diff
changeset
|
1569 ;; - For 'm' MacOS: macos_to_unix_filename() changes "/" to ":" and |
d966323ac214
(archive-lzh-summarize): Only apply the "downcase if all upcase" rule
Chong Yidong <cyd@stupidchicken.com>
parents:
75347
diff
changeset
|
1570 ;; ":" to "/" |
d966323ac214
(archive-lzh-summarize): Only apply the "downcase if all upcase" rule
Chong Yidong <cyd@stupidchicken.com>
parents:
75347
diff
changeset
|
1571 (setq fiddle (cond ((= ?M osid) t) |
d966323ac214
(archive-lzh-summarize): Only apply the "downcase if all upcase" rule
Chong Yidong <cyd@stupidchicken.com>
parents:
75347
diff
changeset
|
1572 ((= 0 osid) (string= efnname (upcase efnname))))) |
49437
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1573 (setq ifnname (if fiddle (downcase efnname) efnname)) |
49238
86973b914660
(archive-arc-rename-entry): Fix error message.
Kim F. Storm <storm@cua.dk>
parents:
49166
diff
changeset
|
1574 (setq prname (if dir (concat dir ifnname) ifnname)) |
49509
389fbac8d443
(archive-lzh-summarize): Fix previous change.
Juanma Barranquero <lekktu@gmail.com>
parents:
49437
diff
changeset
|
1575 (setq width (if prname (string-width prname) 0)) |
20767
ad6c6f1bd674
(archive-find-type): Accept d or s after digit, for lzh.
Richard M. Stallman <rms@gnu.org>
parents:
20239
diff
changeset
|
1576 (setq modestr (if mode (archive-int-to-mode mode) "??????????")) |
49437
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1577 (setq moddate (if (= hdrlvl 2) |
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1578 (archive-unixdate time1 time2) ;level 2 header in UNIX format |
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1579 (archive-dosdate time2))) ;level 0 and 1 header in DOS format |
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1580 (setq modtime (if (= hdrlvl 2) |
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1581 (archive-unixtime time1 time2) |
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1582 (archive-dostime time1))) |
20767
ad6c6f1bd674
(archive-find-type): Accept d or s after digit, for lzh.
Richard M. Stallman <rms@gnu.org>
parents:
20239
diff
changeset
|
1583 (setq text (if archive-alternate-display |
70388
000b130bfb7d
(archive-l-e): New optional argument `float' means generate a float value.
Eli Zaretskii <eliz@gnu.org>
parents:
69331
diff
changeset
|
1584 (format " %8.0f %5S %5S %s" |
11880 | 1585 ucsize |
1586 (or uid "?") | |
1587 (or gid "?") | |
1588 ifnname) | |
70388
000b130bfb7d
(archive-l-e): New optional argument `float' means generate a float value.
Eli Zaretskii <eliz@gnu.org>
parents:
69331
diff
changeset
|
1589 (format " %10s %8.0f %-11s %-8s %s" |
11880 | 1590 modestr |
1591 ucsize | |
49437
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1592 moddate |
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1593 modtime |
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1594 prname))) |
22830
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
1595 (setq maxlen (max maxlen width) |
11880 | 1596 totalsize (+ totalsize ucsize) |
1597 visual (cons (vector text | |
49437
3a18e49975cb
(archive-unixdate): Corrected the date field string.
Richard M. Stallman <rms@gnu.org>
parents:
49238
diff
changeset
|
1598 (- (length text) (length prname)) |
11880 | 1599 (length text)) |
1600 visual) | |
20767
ad6c6f1bd674
(archive-find-type): Accept d or s after digit, for lzh.
Richard M. Stallman <rms@gnu.org>
parents:
20239
diff
changeset
|
1601 files (cons (vector prname ifnname fiddle mode (1- p)) |
51158
00d0f607793b
(archive-lzh-summarize): Calculate correct total
Richard M. Stallman <rms@gnu.org>
parents:
50835
diff
changeset
|
1602 files)) |
00d0f607793b
(archive-lzh-summarize): Calculate correct total
Richard M. Stallman <rms@gnu.org>
parents:
50835
diff
changeset
|
1603 (cond ((= hdrlvl 1) |
70679
ff708eaf43ab
(archive-arc-summarize, archive-lzh-summarize): Convert csize to integer when
Eli Zaretskii <eliz@gnu.org>
parents:
70544
diff
changeset
|
1604 ;; p needs to stay an integer, since we use it in goto-char |
ff708eaf43ab
(archive-arc-summarize, archive-lzh-summarize): Convert csize to integer when
Eli Zaretskii <eliz@gnu.org>
parents:
70544
diff
changeset
|
1605 ;; above. Passing through `round' limits the compressed size |
ff708eaf43ab
(archive-arc-summarize, archive-lzh-summarize): Convert csize to integer when
Eli Zaretskii <eliz@gnu.org>
parents:
70544
diff
changeset
|
1606 ;; to most-positive-fixnum, but if the compressed size exceeds |
ff708eaf43ab
(archive-arc-summarize, archive-lzh-summarize): Convert csize to integer when
Eli Zaretskii <eliz@gnu.org>
parents:
70544
diff
changeset
|
1607 ;; that, we cannot visit the archive anyway. |
ff708eaf43ab
(archive-arc-summarize, archive-lzh-summarize): Convert csize to integer when
Eli Zaretskii <eliz@gnu.org>
parents:
70544
diff
changeset
|
1608 (setq p (+ p hsize 2 (round csize)))) |
51158
00d0f607793b
(archive-lzh-summarize): Calculate correct total
Richard M. Stallman <rms@gnu.org>
parents:
50835
diff
changeset
|
1609 ((or (= hdrlvl 2) (= hdrlvl 0)) |
70679
ff708eaf43ab
(archive-arc-summarize, archive-lzh-summarize): Convert csize to integer when
Eli Zaretskii <eliz@gnu.org>
parents:
70544
diff
changeset
|
1610 (setq p (+ p thsize 2 (round csize))))) |
51158
00d0f607793b
(archive-lzh-summarize): Calculate correct total
Richard M. Stallman <rms@gnu.org>
parents:
50835
diff
changeset
|
1611 )) |
11880 | 1612 (goto-char (point-min)) |
1613 (let ((dash (concat (if archive-alternate-display | |
1614 "- -------- ----- ----- " | |
1615 "- ---------- -------- ----------- -------- ") | |
1616 (make-string maxlen ?-) | |
1617 "\n")) | |
1618 (header (if archive-alternate-display | |
1619 "M Length Uid Gid File\n" | |
1620 "M Filemode Length Date Time File\n")) | |
1621 (sumline (if archive-alternate-display | |
70388
000b130bfb7d
(archive-l-e): New optional argument `float' means generate a float value.
Eli Zaretskii <eliz@gnu.org>
parents:
69331
diff
changeset
|
1622 " %8.0f %d file%s" |
000b130bfb7d
(archive-l-e): New optional argument `float' means generate a float value.
Eli Zaretskii <eliz@gnu.org>
parents:
69331
diff
changeset
|
1623 " %8.0f %d file%s"))) |
11880 | 1624 (insert header dash) |
1625 (archive-summarize-files (nreverse visual)) | |
1626 (insert dash | |
1627 (format sumline | |
1628 totalsize | |
1629 (length files) | |
1630 (if (= 1 (length files)) "" "s")) | |
1631 "\n")) | |
1632 (apply 'vector (nreverse files)))) | |
1633 | |
1634 (defconst archive-lzh-alternate-display t) | |
1635 | |
1636 (defun archive-lzh-extract (archive name) | |
1637 (archive-extract-by-stdout archive name archive-lzh-extract)) | |
1638 | |
1639 (defun archive-lzh-resum (p count) | |
1640 (let ((sum 0)) | |
1641 (while (> count 0) | |
1642 (setq count (1- count) | |
88954
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
1643 sum (+ sum (byte-after p)) |
11880 | 1644 p (1+ p))) |
1645 (logand sum 255))) | |
1646 | |
63891
d7d21c20c225
(archive-extract): Make it work as a mouse binding.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
63889
diff
changeset
|
1647 (defun archive-lzh-rename-entry (newname descr) |
11880 | 1648 (save-restriction |
1649 (save-excursion | |
1650 (widen) | |
1651 (let* ((p (+ archive-proper-file-start (aref descr 4))) | |
88954
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
1652 (oldhsize (byte-after p)) |
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
1653 (oldfnlen (byte-after (+ p 21))) |
11880 | 1654 (newfnlen (length newname)) |
1655 (newhsize (+ oldhsize newfnlen (- oldfnlen))) | |
63889
abe14daaa679
Bind inhibit-read-only rather than buffer-read-only.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
62714
diff
changeset
|
1656 (inhibit-read-only t)) |
11880 | 1657 (if (> newhsize 255) |
1658 (error "The file name is too long")) | |
1659 (goto-char (+ p 21)) | |
1660 (delete-char (1+ oldfnlen)) | |
88954
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
1661 (insert-unibyte newfnlen newname) |
11880 | 1662 (goto-char p) |
1663 (delete-char 2) | |
88954
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
1664 (insert-unibyte newhsize (archive-lzh-resum p newhsize)))))) |
11880 | 1665 |
1666 (defun archive-lzh-ogm (newval files errtxt ofs) | |
64086
2aeabf7911c9
(archive-lzh-ogm): Reorder save excursion/restriction.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
63891
diff
changeset
|
1667 (save-excursion |
2aeabf7911c9
(archive-lzh-ogm): Reorder save excursion/restriction.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
63891
diff
changeset
|
1668 (save-restriction |
11880 | 1669 (widen) |
63889
abe14daaa679
Bind inhibit-read-only rather than buffer-read-only.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
62714
diff
changeset
|
1670 (dolist (fil files) |
abe14daaa679
Bind inhibit-read-only rather than buffer-read-only.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
62714
diff
changeset
|
1671 (let* ((p (+ archive-proper-file-start (aref fil 4))) |
88954
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
1672 (hsize (byte-after p)) |
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
1673 (fnlen (byte-after (+ p 21))) |
11880 | 1674 (p2 (+ p 22 fnlen)) |
88954
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
1675 (creator (if (>= (- hsize fnlen) 24) (byte-after (+ p2 2)) 0)) |
63889
abe14daaa679
Bind inhibit-read-only rather than buffer-read-only.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
62714
diff
changeset
|
1676 (inhibit-read-only t)) |
11880 | 1677 (if (= creator ?U) |
1678 (progn | |
1679 (or (numberp newval) | |
1680 (setq newval (funcall newval (archive-l-e (+ p2 ofs) 2)))) | |
1681 (goto-char (+ p2 ofs)) | |
1682 (delete-char 2) | |
88954
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
1683 (insert-unibyte (logand newval 255) (lsh newval -8)) |
11880 | 1684 (goto-char (1+ p)) |
1685 (delete-char 1) | |
88954
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
1686 (insert-unibyte (archive-lzh-resum (1+ p) hsize))) |
11880 | 1687 (message "Member %s does not have %s field" |
63889
abe14daaa679
Bind inhibit-read-only rather than buffer-read-only.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
62714
diff
changeset
|
1688 (aref fil 1) errtxt))))))) |
11880 | 1689 |
1690 (defun archive-lzh-chown-entry (newuid files) | |
1691 (archive-lzh-ogm newuid files "an uid" 10)) | |
1692 | |
1693 (defun archive-lzh-chgrp-entry (newgid files) | |
1694 (archive-lzh-ogm newgid files "a gid" 12)) | |
1695 | |
1696 (defun archive-lzh-chmod-entry (newmode files) | |
1697 (archive-lzh-ogm | |
1698 ;; This should work even though newmode will be dynamically accessed. | |
63891
d7d21c20c225
(archive-extract): Make it work as a mouse binding.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
63889
diff
changeset
|
1699 (lambda (old) (archive-calc-mode old newmode t)) |
11880 | 1700 files "a unix-style mode" 8)) |
77330
1b3aff56da73
(archive-find-type): lzh-exe for lzh self-extracting exe.
Chong Yidong <cyd@stupidchicken.com>
parents:
77274
diff
changeset
|
1701 |
1b3aff56da73
(archive-find-type): lzh-exe for lzh self-extracting exe.
Chong Yidong <cyd@stupidchicken.com>
parents:
77274
diff
changeset
|
1702 ;; ------------------------------------------------------------------------- |
84661
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1703 ;;; Section: Lzh Self-Extracting .exe Archives |
77330
1b3aff56da73
(archive-find-type): lzh-exe for lzh self-extracting exe.
Chong Yidong <cyd@stupidchicken.com>
parents:
77274
diff
changeset
|
1704 ;; |
1b3aff56da73
(archive-find-type): lzh-exe for lzh self-extracting exe.
Chong Yidong <cyd@stupidchicken.com>
parents:
77274
diff
changeset
|
1705 ;; No support for modifying these files. It looks like the lha for unix |
1b3aff56da73
(archive-find-type): lzh-exe for lzh self-extracting exe.
Chong Yidong <cyd@stupidchicken.com>
parents:
77274
diff
changeset
|
1706 ;; program (as of version 1.14i) can't create or retain the DOS exe part. |
1b3aff56da73
(archive-find-type): lzh-exe for lzh self-extracting exe.
Chong Yidong <cyd@stupidchicken.com>
parents:
77274
diff
changeset
|
1707 ;; If you do an "lha a" on a .exe for instance it renames and writes to a |
1b3aff56da73
(archive-find-type): lzh-exe for lzh self-extracting exe.
Chong Yidong <cyd@stupidchicken.com>
parents:
77274
diff
changeset
|
1708 ;; plain .lzh. |
1b3aff56da73
(archive-find-type): lzh-exe for lzh self-extracting exe.
Chong Yidong <cyd@stupidchicken.com>
parents:
77274
diff
changeset
|
1709 |
1b3aff56da73
(archive-find-type): lzh-exe for lzh self-extracting exe.
Chong Yidong <cyd@stupidchicken.com>
parents:
77274
diff
changeset
|
1710 (defun archive-lzh-exe-summarize () |
1b3aff56da73
(archive-find-type): lzh-exe for lzh self-extracting exe.
Chong Yidong <cyd@stupidchicken.com>
parents:
77274
diff
changeset
|
1711 "Summarize the contents of an LZH self-extracting exe, for `archive-mode'." |
1b3aff56da73
(archive-find-type): lzh-exe for lzh self-extracting exe.
Chong Yidong <cyd@stupidchicken.com>
parents:
77274
diff
changeset
|
1712 |
1b3aff56da73
(archive-find-type): lzh-exe for lzh self-extracting exe.
Chong Yidong <cyd@stupidchicken.com>
parents:
77274
diff
changeset
|
1713 ;; Skip the initial executable code part and apply archive-lzh-summarize |
1b3aff56da73
(archive-find-type): lzh-exe for lzh self-extracting exe.
Chong Yidong <cyd@stupidchicken.com>
parents:
77274
diff
changeset
|
1714 ;; to the archive part proper. The "-lh5-" etc regexp here for the start |
1b3aff56da73
(archive-find-type): lzh-exe for lzh self-extracting exe.
Chong Yidong <cyd@stupidchicken.com>
parents:
77274
diff
changeset
|
1715 ;; is the same as in archive-find-type. |
1b3aff56da73
(archive-find-type): lzh-exe for lzh self-extracting exe.
Chong Yidong <cyd@stupidchicken.com>
parents:
77274
diff
changeset
|
1716 ;; |
1b3aff56da73
(archive-find-type): lzh-exe for lzh self-extracting exe.
Chong Yidong <cyd@stupidchicken.com>
parents:
77274
diff
changeset
|
1717 ;; The lha program (version 1.14i) does this in skip_msdos_sfx1_code() by |
1b3aff56da73
(archive-find-type): lzh-exe for lzh self-extracting exe.
Chong Yidong <cyd@stupidchicken.com>
parents:
77274
diff
changeset
|
1718 ;; a similar scan. It looks for "..-l..-" plus for level 0 or 1 a test of |
1b3aff56da73
(archive-find-type): lzh-exe for lzh self-extracting exe.
Chong Yidong <cyd@stupidchicken.com>
parents:
77274
diff
changeset
|
1719 ;; the header checksum, or level 2 a test of the "attribute" and size. |
1b3aff56da73
(archive-find-type): lzh-exe for lzh self-extracting exe.
Chong Yidong <cyd@stupidchicken.com>
parents:
77274
diff
changeset
|
1720 ;; |
1b3aff56da73
(archive-find-type): lzh-exe for lzh self-extracting exe.
Chong Yidong <cyd@stupidchicken.com>
parents:
77274
diff
changeset
|
1721 (re-search-forward "..-l[hz][0-9ds]-" nil) |
1b3aff56da73
(archive-find-type): lzh-exe for lzh self-extracting exe.
Chong Yidong <cyd@stupidchicken.com>
parents:
77274
diff
changeset
|
1722 (archive-lzh-summarize (match-beginning 0))) |
1b3aff56da73
(archive-find-type): lzh-exe for lzh self-extracting exe.
Chong Yidong <cyd@stupidchicken.com>
parents:
77274
diff
changeset
|
1723 |
1b3aff56da73
(archive-find-type): lzh-exe for lzh self-extracting exe.
Chong Yidong <cyd@stupidchicken.com>
parents:
77274
diff
changeset
|
1724 ;; `archive-lzh-extract' runs "lha pq", and that works for .exe as well as |
1b3aff56da73
(archive-find-type): lzh-exe for lzh self-extracting exe.
Chong Yidong <cyd@stupidchicken.com>
parents:
77274
diff
changeset
|
1725 ;; .lzh files |
1b3aff56da73
(archive-find-type): lzh-exe for lzh self-extracting exe.
Chong Yidong <cyd@stupidchicken.com>
parents:
77274
diff
changeset
|
1726 (defalias 'archive-lzh-exe-extract 'archive-lzh-extract |
1b3aff56da73
(archive-find-type): lzh-exe for lzh self-extracting exe.
Chong Yidong <cyd@stupidchicken.com>
parents:
77274
diff
changeset
|
1727 "Extract a member from an LZH self-extracting exe, for `archive-mode'.") |
1b3aff56da73
(archive-find-type): lzh-exe for lzh self-extracting exe.
Chong Yidong <cyd@stupidchicken.com>
parents:
77274
diff
changeset
|
1728 |
11880 | 1729 ;; ------------------------------------------------------------------------- |
84661
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1730 ;;; Section: Zip Archives |
11880 | 1731 |
1732 (defun archive-zip-summarize () | |
1733 (goto-char (- (point-max) (- 22 18))) | |
1734 (search-backward-regexp "[P]K\005\006") | |
48226
65903e252ec1
(archive-zip-summarize): Don't hardcode (point-min) = 1.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
45363
diff
changeset
|
1735 (let ((p (+ (point-min) (archive-l-e (+ (point) 16) 4))) |
11880 | 1736 (maxlen 8) |
1737 (totalsize 0) | |
1738 files | |
1739 visual) | |
1740 (while (string= "PK\001\002" (buffer-substring p (+ p 4))) | |
88954
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
1741 (let* ((creator (byte-after (+ p 5))) |
63891
d7d21c20c225
(archive-extract): Make it work as a mouse binding.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
63889
diff
changeset
|
1742 ;; (method (archive-l-e (+ p 10) 2)) |
11880 | 1743 (modtime (archive-l-e (+ p 12) 2)) |
1744 (moddate (archive-l-e (+ p 14) 2)) | |
70388
000b130bfb7d
(archive-l-e): New optional argument `float' means generate a float value.
Eli Zaretskii <eliz@gnu.org>
parents:
69331
diff
changeset
|
1745 ;; Convert to float to avoid overflow for very large files. |
000b130bfb7d
(archive-l-e): New optional argument `float' means generate a float value.
Eli Zaretskii <eliz@gnu.org>
parents:
69331
diff
changeset
|
1746 (ucsize (archive-l-e (+ p 24) 4 'float)) |
11880 | 1747 (fnlen (archive-l-e (+ p 28) 2)) |
1748 (exlen (archive-l-e (+ p 30) 2)) | |
12304
3cf4df625c3b
(archive-zip-summarize): Handle per-file comments in central directory.
Richard M. Stallman <rms@gnu.org>
parents:
12024
diff
changeset
|
1749 (fclen (archive-l-e (+ p 32) 2)) |
11880 | 1750 (lheader (archive-l-e (+ p 42) 4)) |
22830
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
1751 (efnname (let ((str (buffer-substring (+ p 46) (+ p 46 fnlen)))) |
88954
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
1752 (decode-coding-string |
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
1753 str archive-file-name-coding-system))) |
11880 | 1754 (isdir (and (= ucsize 0) |
1755 (string= (file-name-nondirectory efnname) ""))) | |
97142 | 1756 (mode (cond ((memq creator '(2 3)) ; Unix |
11880 | 1757 (archive-l-e (+ p 40) 2)) |
22062
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
1758 ((memq creator '(0 5 6 7 10 11 15)) ; Dos etc. |
11880 | 1759 (logior ?\444 |
1760 (if isdir (logior 16384 ?\111) 0) | |
1761 (if (zerop | |
88954
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
1762 (logand 1 (byte-after (+ p 38)))) |
11880 | 1763 ?\222 0))) |
1764 (t nil))) | |
1765 (modestr (if mode (archive-int-to-mode mode) "??????????")) | |
1766 (fiddle (and archive-zip-case-fiddle | |
22062
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
1767 (not (not (memq creator '(0 2 4 5 9)))) |
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
1768 (string= (upcase efnname) efnname))) |
11880 | 1769 (ifnname (if fiddle (downcase efnname) efnname)) |
22830
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
1770 (width (string-width ifnname)) |
70388
000b130bfb7d
(archive-l-e): New optional argument `float' means generate a float value.
Eli Zaretskii <eliz@gnu.org>
parents:
69331
diff
changeset
|
1771 (text (format " %10s %8.0f %-11s %-8s %s" |
11880 | 1772 modestr |
1773 ucsize | |
1774 (archive-dosdate moddate) | |
1775 (archive-dostime modtime) | |
1776 ifnname))) | |
22830
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
1777 (setq maxlen (max maxlen width) |
11880 | 1778 totalsize (+ totalsize ucsize) |
1779 visual (cons (vector text | |
1780 (- (length text) (length ifnname)) | |
1781 (length text)) | |
1782 visual) | |
1783 files (cons (if isdir | |
1784 nil | |
1785 (vector efnname ifnname fiddle mode | |
1786 (list (1- p) lheader))) | |
1787 files) | |
12304
3cf4df625c3b
(archive-zip-summarize): Handle per-file comments in central directory.
Richard M. Stallman <rms@gnu.org>
parents:
12024
diff
changeset
|
1788 p (+ p 46 fnlen exlen fclen)))) |
11880 | 1789 (goto-char (point-min)) |
1790 (let ((dash (concat "- ---------- -------- ----------- -------- " | |
1791 (make-string maxlen ?-) | |
1792 "\n"))) | |
1793 (insert "M Filemode Length Date Time File\n" | |
1794 dash) | |
1795 (archive-summarize-files (nreverse visual)) | |
1796 (insert dash | |
70388
000b130bfb7d
(archive-l-e): New optional argument `float' means generate a float value.
Eli Zaretskii <eliz@gnu.org>
parents:
69331
diff
changeset
|
1797 (format " %8.0f %d file%s" |
11880 | 1798 totalsize |
1799 (length files) | |
1800 (if (= 1 (length files)) "" "s")) | |
1801 "\n")) | |
1802 (apply 'vector (nreverse files)))) | |
1803 | |
1804 (defun archive-zip-extract (archive name) | |
107896
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
1805 (cond |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
1806 ((member-ignore-case (car archive-zip-extract) '("pkunzip" "pkzip")) |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
1807 (archive-*-extract archive name archive-zip-extract)) |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
1808 ((equal (car archive-zip-extract) "7z") |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
1809 (let ((archive-7z-extract archive-zip-extract)) |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
1810 (archive-7z-extract archive name))) |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
1811 (t |
107071
bdf05c504564
* arc-mode.el (archive-zip-extract): Use `member-ignore-case' to
Juri Linkov <juri@jurta.org>
parents:
107039
diff
changeset
|
1812 (archive-extract-by-stdout |
bdf05c504564
* arc-mode.el (archive-zip-extract): Use `member-ignore-case' to
Juri Linkov <juri@jurta.org>
parents:
107039
diff
changeset
|
1813 archive |
109277 | 1814 ;; unzip expands wildcards in NAME, so we need to quote it. But |
1815 ;; not on DOS/Windows, since that fails extraction on those | |
1816 ;; systems, and file names with wildcards in zip archives don't | |
1817 ;; work there anyway. | |
107071
bdf05c504564
* arc-mode.el (archive-zip-extract): Use `member-ignore-case' to
Juri Linkov <juri@jurta.org>
parents:
107039
diff
changeset
|
1818 ;; FIXME: Does pkunzip need similar treatment? |
109277 | 1819 (if (and (not (memq system-type '(windows-nt ms-dos))) |
1820 (equal (car archive-zip-extract) "unzip")) | |
107071
bdf05c504564
* arc-mode.el (archive-zip-extract): Use `member-ignore-case' to
Juri Linkov <juri@jurta.org>
parents:
107039
diff
changeset
|
1821 (shell-quote-argument name) |
bdf05c504564
* arc-mode.el (archive-zip-extract): Use `member-ignore-case' to
Juri Linkov <juri@jurta.org>
parents:
107039
diff
changeset
|
1822 name) |
107896
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
1823 archive-zip-extract)))) |
11880 | 1824 |
1825 (defun archive-zip-write-file-member (archive descr) | |
1826 (archive-*-write-file-member | |
1827 archive | |
1828 descr | |
1829 (if (aref descr 2) archive-zip-update-case archive-zip-update))) | |
1830 | |
1831 (defun archive-zip-chmod-entry (newmode files) | |
1832 (save-restriction | |
1833 (save-excursion | |
1834 (widen) | |
63889
abe14daaa679
Bind inhibit-read-only rather than buffer-read-only.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
62714
diff
changeset
|
1835 (dolist (fil files) |
abe14daaa679
Bind inhibit-read-only rather than buffer-read-only.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
62714
diff
changeset
|
1836 (let* ((p (+ archive-proper-file-start (car (aref fil 4)))) |
88954
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
1837 (creator (byte-after (+ p 5))) |
11880 | 1838 (oldmode (aref fil 3)) |
1839 (newval (archive-calc-mode oldmode newmode t)) | |
63889
abe14daaa679
Bind inhibit-read-only rather than buffer-read-only.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
62714
diff
changeset
|
1840 (inhibit-read-only t)) |
97142 | 1841 (cond ((memq creator '(2 3)) ; Unix |
11880 | 1842 (goto-char (+ p 40)) |
1843 (delete-char 2) | |
88954
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
1844 (insert-unibyte (logand newval 255) (lsh newval -8))) |
22062
029145c16497
(archive-tmpdir): Make the prefix of the temporary
Eli Zaretskii <eliz@gnu.org>
parents:
21570
diff
changeset
|
1845 ((memq creator '(0 5 6 7 10 11 15)) ; Dos etc. |
11880 | 1846 (goto-char (+ p 38)) |
88954
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
1847 (insert-unibyte (logior (logand (byte-after (point)) 254) |
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
1848 (logand (logxor 1 (lsh newval -7)) 1))) |
11880 | 1849 (delete-char 1)) |
1850 (t (message "Don't know how to change mode for this member")))) | |
63889
abe14daaa679
Bind inhibit-read-only rather than buffer-read-only.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
62714
diff
changeset
|
1851 )))) |
11880 | 1852 ;; ------------------------------------------------------------------------- |
84661
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1853 ;;; Section: Zoo Archives |
11880 | 1854 |
1855 (defun archive-zoo-summarize () | |
1856 (let ((p (1+ (archive-l-e 25 4))) | |
1857 (maxlen 8) | |
1858 (totalsize 0) | |
1859 files | |
1860 visual) | |
1861 (while (and (string= "\334\247\304\375" (buffer-substring p (+ p 4))) | |
1862 (> (archive-l-e (+ p 6) 4) 0)) | |
1863 (let* ((next (1+ (archive-l-e (+ p 6) 4))) | |
1864 (moddate (archive-l-e (+ p 14) 2)) | |
1865 (modtime (archive-l-e (+ p 16) 2)) | |
70388
000b130bfb7d
(archive-l-e): New optional argument `float' means generate a float value.
Eli Zaretskii <eliz@gnu.org>
parents:
69331
diff
changeset
|
1866 ;; Convert to float to avoid overflow for very large files. |
000b130bfb7d
(archive-l-e): New optional argument `float' means generate a float value.
Eli Zaretskii <eliz@gnu.org>
parents:
69331
diff
changeset
|
1867 (ucsize (archive-l-e (+ p 20) 4 'float)) |
11880 | 1868 (namefld (buffer-substring (+ p 38) (+ p 38 13))) |
88954
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
1869 (dirtype (byte-after (+ p 4))) |
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
1870 (lfnlen (if (= dirtype 2) (byte-after (+ p 56)) 0)) |
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
1871 (ldirlen (if (= dirtype 2) (byte-after (+ p 57)) 0)) |
20239
5bf13ca1dbac
(archive-zoo-summarize): Properly handle the case of
Andreas Schwab <schwab@suse.de>
parents:
19998
diff
changeset
|
1872 (fnlen (or (string-match "\0" namefld) 13)) |
22830
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
1873 (efnname (let ((str |
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
1874 (concat |
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
1875 (if (> ldirlen 0) |
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
1876 (concat (buffer-substring |
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
1877 (+ p 58 lfnlen) |
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
1878 (+ p 58 lfnlen ldirlen -1)) |
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
1879 "/") |
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
1880 "") |
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
1881 (if (> lfnlen 0) |
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
1882 (buffer-substring (+ p 58) |
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
1883 (+ p 58 lfnlen -1)) |
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
1884 (substring namefld 0 fnlen))))) |
88954
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
1885 (decode-coding-string |
363e137c2601
(archive-file-name-coding-system): New variable.
Kenichi Handa <handa@m17n.org>
parents:
42704
diff
changeset
|
1886 str archive-file-name-coding-system))) |
13339
13b7b667b18f
(archive-zoo-summarize): Handle archives with long file names.
Richard M. Stallman <rms@gnu.org>
parents:
12791
diff
changeset
|
1887 (fiddle (and (= lfnlen 0) (string= efnname (upcase efnname)))) |
11880 | 1888 (ifnname (if fiddle (downcase efnname) efnname)) |
22830
d79de5a60ee8
(archive-summarize): Set buffer unibyte before
Eli Zaretskii <eliz@gnu.org>
parents:
22782
diff
changeset
|
1889 (width (string-width ifnname)) |
70388
000b130bfb7d
(archive-l-e): New optional argument `float' means generate a float value.
Eli Zaretskii <eliz@gnu.org>
parents:
69331
diff
changeset
|
1890 (text (format " %8.0f %-11s %-8s %s" |
11880 | 1891 ucsize |
1892 (archive-dosdate moddate) | |
1893 (archive-dostime modtime) | |
1894 ifnname))) | |
32484
bb1bfa010bf3
(archive-zoo-summarize): Fix from gnu.emacs.bug.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
29681
diff
changeset
|
1895 (setq maxlen (max maxlen width) |
11880 | 1896 totalsize (+ totalsize ucsize) |
1897 visual (cons (vector text | |
1898 (- (length text) (length ifnname)) | |
1899 (length text)) | |
1900 visual) | |
1901 files (cons (vector efnname ifnname fiddle nil (1- p)) | |
1902 files) | |
1903 p next))) | |
1904 (goto-char (point-min)) | |
1905 (let ((dash (concat "- -------- ----------- -------- " | |
1906 (make-string maxlen ?-) | |
1907 "\n"))) | |
1908 (insert "M Length Date Time File\n" | |
1909 dash) | |
1910 (archive-summarize-files (nreverse visual)) | |
1911 (insert dash | |
70388
000b130bfb7d
(archive-l-e): New optional argument `float' means generate a float value.
Eli Zaretskii <eliz@gnu.org>
parents:
69331
diff
changeset
|
1912 (format " %8.0f %d file%s" |
11880 | 1913 totalsize |
1914 (length files) | |
1915 (if (= 1 (length files)) "" "s")) | |
1916 "\n")) | |
1917 (apply 'vector (nreverse files)))) | |
1918 | |
1919 (defun archive-zoo-extract (archive name) | |
1920 (archive-extract-by-stdout archive name archive-zoo-extract)) | |
84661
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1921 |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1922 ;; ------------------------------------------------------------------------- |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1923 ;;; Section: Rar Archives |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1924 |
86928
29dfee94a77f
(archive-find-type): Add recognition of rar-exe format.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
84661
diff
changeset
|
1925 (defun archive-rar-summarize (&optional file) |
29dfee94a77f
(archive-find-type): Add recognition of rar-exe format.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
84661
diff
changeset
|
1926 ;; File is used internally for `archive-rar-exe-summarize'. |
29dfee94a77f
(archive-find-type): Add recognition of rar-exe format.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
84661
diff
changeset
|
1927 (unless file (setq file buffer-file-name)) |
29dfee94a77f
(archive-find-type): Add recognition of rar-exe format.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
84661
diff
changeset
|
1928 (let* ((copy (file-local-copy file)) |
84661
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1929 (maxname 10) |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1930 (maxsize 5) |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1931 (files ())) |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1932 (with-temp-buffer |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1933 (call-process "unrar-free" nil t nil "--list" (or file copy)) |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1934 (if copy (delete-file copy)) |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1935 (goto-char (point-min)) |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1936 (re-search-forward "^-+\n") |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1937 (while (looking-at (concat " \\(.*\\)\n" ;Name. |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1938 ;; Size ; Packed. |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1939 " +\\([0-9]+\\) +[0-9]+" |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1940 ;; Ratio ; Date' |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1941 " +\\([0-9%]+\\) +\\([-0-9]+\\)" |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1942 ;; Time ; Attr. |
106546
8ab9e8e5e845
(archive-rar-summarize): Support Attribute fields in RAR archives
Eli Zaretskii <eliz@gnu.org>
parents:
106523
diff
changeset
|
1943 " +\\([0-9:]+\\) +[^ \n]\\{6,10\\}" |
84661
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1944 ;; CRC; Meth ; Var. |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1945 " +[0-9A-F]+ +[^ \n]+ +[0-9.]+\n")) |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1946 (goto-char (match-end 0)) |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1947 (let ((name (match-string 1)) |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1948 (size (match-string 2))) |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1949 (if (> (length name) maxname) (setq maxname (length name))) |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1950 (if (> (length size) maxsize) (setq maxsize (length size))) |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1951 (push (vector name name nil nil |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1952 ;; Size, Ratio. |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1953 size (match-string 3) |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1954 ;; Date, Time. |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1955 (match-string 4) (match-string 5)) |
86928
29dfee94a77f
(archive-find-type): Add recognition of rar-exe format.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
84661
diff
changeset
|
1956 files)))) |
84661
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1957 (setq files (nreverse files)) |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1958 (goto-char (point-min)) |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1959 (let* ((format (format " %%s %%s %%%ds %%5s %%s" maxsize)) |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1960 (sep (format format "--------" "-----" (make-string maxsize ?-) |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1961 "-----" "")) |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1962 (column (length sep))) |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1963 (insert (format format " Date " "Time " "Size " "Ratio" " Filename") "\n") |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1964 (insert sep (make-string maxname ?-) "\n") |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1965 (archive-summarize-files (mapcar (lambda (desc) |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1966 (let ((text |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1967 (format format |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1968 (aref desc 6) |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1969 (aref desc 7) |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1970 (aref desc 4) |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1971 (aref desc 5) |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1972 (aref desc 1)))) |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1973 (vector text |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1974 column |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1975 (length text)))) |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1976 files)) |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1977 (insert sep (make-string maxname ?-) "\n") |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1978 (apply 'vector files)))) |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1979 |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1980 (defun archive-rar-extract (archive name) |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1981 ;; unrar-free seems to have no way to extract to stdout or even to a file. |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1982 (if (file-name-absolute-p name) |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1983 ;; The code below assumes the name is relative and may do undesirable |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1984 ;; things otherwise. |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1985 (error "Can't extract files with non-relative names") |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1986 (let ((dest (make-temp-file "arc-rar" 'dir))) |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1987 (unwind-protect |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1988 (progn |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1989 (call-process "unrar-free" nil nil nil |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1990 "--extract" archive name dest) |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1991 (insert-file-contents-literally (expand-file-name name dest))) |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1992 (delete-file (expand-file-name name dest)) |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1993 (while (file-name-directory name) |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1994 (setq name (directory-file-name (file-name-directory name))) |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1995 (delete-directory (expand-file-name name dest))) |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1996 (delete-directory dest))))) |
c85ffd1fab82
Add basic support for Rar.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
1997 |
86928
29dfee94a77f
(archive-find-type): Add recognition of rar-exe format.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
84661
diff
changeset
|
1998 ;;; Section: Rar self-extracting .exe archives. |
29dfee94a77f
(archive-find-type): Add recognition of rar-exe format.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
84661
diff
changeset
|
1999 |
29dfee94a77f
(archive-find-type): Add recognition of rar-exe format.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
84661
diff
changeset
|
2000 (defun archive-rar-exe-summarize () |
29dfee94a77f
(archive-find-type): Add recognition of rar-exe format.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
84661
diff
changeset
|
2001 (let ((tmpfile (make-temp-file "rarexe"))) |
29dfee94a77f
(archive-find-type): Add recognition of rar-exe format.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
84661
diff
changeset
|
2002 (unwind-protect |
29dfee94a77f
(archive-find-type): Add recognition of rar-exe format.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
84661
diff
changeset
|
2003 (progn |
29dfee94a77f
(archive-find-type): Add recognition of rar-exe format.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
84661
diff
changeset
|
2004 (goto-char (point-min)) |
29dfee94a77f
(archive-find-type): Add recognition of rar-exe format.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
84661
diff
changeset
|
2005 (re-search-forward "Rar!") |
29dfee94a77f
(archive-find-type): Add recognition of rar-exe format.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
84661
diff
changeset
|
2006 (write-region (match-beginning 0) (point-max) tmpfile) |
29dfee94a77f
(archive-find-type): Add recognition of rar-exe format.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
84661
diff
changeset
|
2007 (archive-rar-summarize tmpfile)) |
29dfee94a77f
(archive-find-type): Add recognition of rar-exe format.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
84661
diff
changeset
|
2008 (delete-file tmpfile)))) |
29dfee94a77f
(archive-find-type): Add recognition of rar-exe format.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
84661
diff
changeset
|
2009 |
29dfee94a77f
(archive-find-type): Add recognition of rar-exe format.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
84661
diff
changeset
|
2010 (defun archive-rar-exe-extract (archive name) |
29dfee94a77f
(archive-find-type): Add recognition of rar-exe format.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
84661
diff
changeset
|
2011 (let* ((tmpfile (make-temp-file "rarexe")) |
29dfee94a77f
(archive-find-type): Add recognition of rar-exe format.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
84661
diff
changeset
|
2012 (buf (find-buffer-visiting archive)) |
29dfee94a77f
(archive-find-type): Add recognition of rar-exe format.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
84661
diff
changeset
|
2013 (tmpbuf (unless buf (generate-new-buffer " *rar-exe*")))) |
29dfee94a77f
(archive-find-type): Add recognition of rar-exe format.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
84661
diff
changeset
|
2014 (unwind-protect |
29dfee94a77f
(archive-find-type): Add recognition of rar-exe format.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
84661
diff
changeset
|
2015 (progn |
29dfee94a77f
(archive-find-type): Add recognition of rar-exe format.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
84661
diff
changeset
|
2016 (with-current-buffer (or buf tmpbuf) |
29dfee94a77f
(archive-find-type): Add recognition of rar-exe format.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
84661
diff
changeset
|
2017 (save-excursion |
29dfee94a77f
(archive-find-type): Add recognition of rar-exe format.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
84661
diff
changeset
|
2018 (save-restriction |
29dfee94a77f
(archive-find-type): Add recognition of rar-exe format.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
84661
diff
changeset
|
2019 (if buf |
29dfee94a77f
(archive-find-type): Add recognition of rar-exe format.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
84661
diff
changeset
|
2020 ;; point-max unwidened is assumed to be the end of the |
29dfee94a77f
(archive-find-type): Add recognition of rar-exe format.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
84661
diff
changeset
|
2021 ;; summary text and the beginning of the actual file data. |
29dfee94a77f
(archive-find-type): Add recognition of rar-exe format.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
84661
diff
changeset
|
2022 (progn (goto-char (point-max)) (widen)) |
29dfee94a77f
(archive-find-type): Add recognition of rar-exe format.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
84661
diff
changeset
|
2023 (insert-file-contents-literally archive) |
29dfee94a77f
(archive-find-type): Add recognition of rar-exe format.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
84661
diff
changeset
|
2024 (goto-char (point-min))) |
29dfee94a77f
(archive-find-type): Add recognition of rar-exe format.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
84661
diff
changeset
|
2025 (re-search-forward "Rar!") |
29dfee94a77f
(archive-find-type): Add recognition of rar-exe format.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
84661
diff
changeset
|
2026 (write-region (match-beginning 0) (point-max) tmpfile)))) |
29dfee94a77f
(archive-find-type): Add recognition of rar-exe format.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
84661
diff
changeset
|
2027 (archive-rar-extract tmpfile name)) |
29dfee94a77f
(archive-find-type): Add recognition of rar-exe format.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
84661
diff
changeset
|
2028 (if tmpbuf (kill-buffer tmpbuf)) |
29dfee94a77f
(archive-find-type): Add recognition of rar-exe format.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
84661
diff
changeset
|
2029 (delete-file tmpfile)))) |
88039
e74ef2442a4a
(archive-extract): Use kill-buffer-if-not-modified as
Martin Rudalics <rudalics@gmx.at>
parents:
87649
diff
changeset
|
2030 |
107896
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2031 ;; ------------------------------------------------------------------------- |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2032 ;;; Section: 7z Archives |
86928
29dfee94a77f
(archive-find-type): Add recognition of rar-exe format.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
84661
diff
changeset
|
2033 |
107896
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2034 (defun archive-7z-summarize () |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2035 (let ((maxname 10) |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2036 (maxsize 5) |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2037 (file buffer-file-name) |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2038 (files ())) |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2039 (with-temp-buffer |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2040 (call-process "7z" nil t nil "l" "-slt" file) |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2041 (goto-char (point-min)) |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2042 (re-search-forward "^-+\n") |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2043 (while (re-search-forward "^Path = \\(.*\\)\n" nil t) |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2044 (goto-char (match-end 0)) |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2045 (let ((name (match-string 1)) |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2046 (size (save-excursion |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2047 (and (re-search-forward "^Size = \\(.*\\)\n") |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2048 (match-string 1)))) |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2049 (time (save-excursion |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2050 (and (re-search-forward "^Modified = \\(.*\\)\n") |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2051 (match-string 1))))) |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2052 (if (> (length name) maxname) (setq maxname (length name))) |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2053 (if (> (length size) maxsize) (setq maxsize (length size))) |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2054 (push (vector name name nil nil time nil nil size) |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2055 files)))) |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2056 (setq files (nreverse files)) |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2057 (goto-char (point-min)) |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2058 (let* ((format (format " %%%ds %%s %%s" maxsize)) |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2059 (sep (format format (make-string maxsize ?-) "-------------------" "")) |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2060 (column (length sep))) |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2061 (insert (format format "Size " "Date Time " " Filename") "\n") |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2062 (insert sep (make-string maxname ?-) "\n") |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2063 (archive-summarize-files (mapcar (lambda (desc) |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2064 (let ((text |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2065 (format format |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2066 (aref desc 7) |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2067 (aref desc 4) |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2068 (aref desc 1)))) |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2069 (vector text |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2070 column |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2071 (length text)))) |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2072 files)) |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2073 (insert sep (make-string maxname ?-) "\n") |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2074 (apply 'vector files)))) |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2075 |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2076 (defun archive-7z-extract (archive name) |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2077 (let ((tmpfile (make-temp-file "7z-stderr"))) |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2078 ;; 7z doesn't provide a `quiet' option to suppress non-essential |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2079 ;; stderr messages. So redirect stderr to a temp file and display it |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2080 ;; in the echo area when it contains error messages. |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2081 (prog1 (archive-extract-by-stdout |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2082 archive name archive-7z-extract tmpfile) |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2083 (with-temp-buffer |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2084 (insert-file-contents tmpfile) |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2085 (unless (search-forward "Everything is Ok" nil t) |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2086 (message "%s" (buffer-string))) |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2087 (delete-file tmpfile))))) |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2088 |
f9390ec51de5
Add 7z archive format support (bug#5475).
Juri Linkov <juri@jurta.org>
parents:
107136
diff
changeset
|
2089 ;; ------------------------------------------------------------------------- |
92538
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2090 ;;; Section `ar' archives. |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2091 |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2092 ;; TODO: we currently only handle the basic format of ar archives, |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2093 ;; not the GNU nor the BSD extensions. As it turns out, this is sufficient |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2094 ;; for .deb packages. |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2095 |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2096 (autoload 'tar-grind-file-mode "tar-mode") |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2097 |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2098 (defconst archive-ar-file-header-re |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2099 "\\(.\\{16\\}\\)\\([ 0-9]\\{12\\}\\)\\([ 0-9]\\{6\\}\\)\\([ 0-9]\\{6\\}\\)\\([ 0-7]\\{8\\}\\)\\([ 0-9]\\{10\\}\\)`\n") |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2100 |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2101 (defun archive-ar-summarize () |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2102 ;; File is used internally for `archive-rar-exe-summarize'. |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2103 (let* ((maxname 10) |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2104 (maxtime 16) |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2105 (maxuser 5) |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2106 (maxgroup 5) |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2107 (maxmode 8) |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2108 (maxsize 5) |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2109 (files ())) |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2110 (goto-char (point-min)) |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2111 (search-forward "!<arch>\n") |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2112 (while (looking-at archive-ar-file-header-re) |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2113 (let ((name (match-string 1)) |
102732
febdeb5803fd
(archive-ar-summarize): Don't burp on special GNU
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
100908
diff
changeset
|
2114 extname |
92538
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2115 ;; Emacs will automatically use float here because those |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2116 ;; timestamps don't fit in our ints. |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2117 (time (string-to-number (match-string 2))) |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2118 (user (match-string 3)) |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2119 (group (match-string 4)) |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2120 (mode (string-to-number (match-string 5) 8)) |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2121 (size (string-to-number (match-string 6)))) |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2122 ;; Move to the beginning of the data. |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2123 (goto-char (match-end 0)) |
102732
febdeb5803fd
(archive-ar-summarize): Don't burp on special GNU
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
100908
diff
changeset
|
2124 (setq time |
febdeb5803fd
(archive-ar-summarize): Don't burp on special GNU
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
100908
diff
changeset
|
2125 (format-time-string |
febdeb5803fd
(archive-ar-summarize): Don't burp on special GNU
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
100908
diff
changeset
|
2126 "%Y-%m-%d %H:%M" |
febdeb5803fd
(archive-ar-summarize): Don't burp on special GNU
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
100908
diff
changeset
|
2127 (let ((high (truncate (/ time 65536)))) |
febdeb5803fd
(archive-ar-summarize): Don't burp on special GNU
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
100908
diff
changeset
|
2128 (list high (truncate (- time (* 65536.0 high))))))) |
febdeb5803fd
(archive-ar-summarize): Don't burp on special GNU
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
100908
diff
changeset
|
2129 (setq extname |
febdeb5803fd
(archive-ar-summarize): Don't burp on special GNU
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
100908
diff
changeset
|
2130 (cond ((equal name "// ") |
febdeb5803fd
(archive-ar-summarize): Don't burp on special GNU
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
100908
diff
changeset
|
2131 (propertize ".<ExtNamesTable>." 'face 'italic)) |
febdeb5803fd
(archive-ar-summarize): Don't burp on special GNU
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
100908
diff
changeset
|
2132 ((equal name "/ ") |
febdeb5803fd
(archive-ar-summarize): Don't burp on special GNU
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
100908
diff
changeset
|
2133 (propertize ".<LookupTable>." 'face 'italic)) |
febdeb5803fd
(archive-ar-summarize): Don't burp on special GNU
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
100908
diff
changeset
|
2134 ((string-match "/? *\\'" name) |
febdeb5803fd
(archive-ar-summarize): Don't burp on special GNU
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
100908
diff
changeset
|
2135 (substring name 0 (match-beginning 0))))) |
febdeb5803fd
(archive-ar-summarize): Don't burp on special GNU
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
100908
diff
changeset
|
2136 (setq user (substring user 0 (string-match " +\\'" user))) |
febdeb5803fd
(archive-ar-summarize): Don't burp on special GNU
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
100908
diff
changeset
|
2137 (setq group (substring group 0 (string-match " +\\'" group))) |
febdeb5803fd
(archive-ar-summarize): Don't burp on special GNU
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
100908
diff
changeset
|
2138 (setq mode (tar-grind-file-mode mode)) |
febdeb5803fd
(archive-ar-summarize): Don't burp on special GNU
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
100908
diff
changeset
|
2139 ;; Move to the end of the data. |
febdeb5803fd
(archive-ar-summarize): Don't burp on special GNU
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
100908
diff
changeset
|
2140 (forward-char size) (if (eq ?\n (char-after)) (forward-char 1)) |
febdeb5803fd
(archive-ar-summarize): Don't burp on special GNU
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
100908
diff
changeset
|
2141 (setq size (number-to-string size)) |
febdeb5803fd
(archive-ar-summarize): Don't burp on special GNU
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
100908
diff
changeset
|
2142 (if (> (length name) maxname) (setq maxname (length name))) |
febdeb5803fd
(archive-ar-summarize): Don't burp on special GNU
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
100908
diff
changeset
|
2143 (if (> (length time) maxtime) (setq maxtime (length time))) |
febdeb5803fd
(archive-ar-summarize): Don't burp on special GNU
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
100908
diff
changeset
|
2144 (if (> (length user) maxuser) (setq maxuser (length user))) |
febdeb5803fd
(archive-ar-summarize): Don't burp on special GNU
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
100908
diff
changeset
|
2145 (if (> (length group) maxgroup) (setq maxgroup (length group))) |
febdeb5803fd
(archive-ar-summarize): Don't burp on special GNU
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
100908
diff
changeset
|
2146 (if (> (length mode) maxmode) (setq maxmode (length mode))) |
febdeb5803fd
(archive-ar-summarize): Don't burp on special GNU
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
100908
diff
changeset
|
2147 (if (> (length size) maxsize) (setq maxsize (length size))) |
febdeb5803fd
(archive-ar-summarize): Don't burp on special GNU
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
100908
diff
changeset
|
2148 (push (vector name extname nil mode |
febdeb5803fd
(archive-ar-summarize): Don't burp on special GNU
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
100908
diff
changeset
|
2149 time user group size) |
febdeb5803fd
(archive-ar-summarize): Don't burp on special GNU
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
100908
diff
changeset
|
2150 files))) |
92538
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2151 (setq files (nreverse files)) |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2152 (goto-char (point-min)) |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2153 (let* ((format (format "%%%ds %%%ds/%%-%ds %%%ds %%%ds %%s" |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2154 maxmode maxuser maxgroup maxsize maxtime)) |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2155 (sep (format format (make-string maxmode ?-) |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2156 (make-string maxuser ?-) |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2157 (make-string maxgroup ?-) |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2158 (make-string maxsize ?-) |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2159 (make-string maxtime ?-) "")) |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2160 (column (length sep))) |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2161 (insert (format format " Mode " "User" "Group" " Size " |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2162 " Date " "Filename") |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2163 "\n") |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2164 (insert sep (make-string maxname ?-) "\n") |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2165 (archive-summarize-files (mapcar (lambda (desc) |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2166 (let ((text |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2167 (format format |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2168 (aref desc 3) |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2169 (aref desc 5) |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2170 (aref desc 6) |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2171 (aref desc 7) |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2172 (aref desc 4) |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2173 (aref desc 1)))) |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2174 (vector text |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2175 column |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2176 (length text)))) |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2177 files)) |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2178 (insert sep (make-string maxname ?-) "\n") |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2179 (apply 'vector files)))) |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2180 |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2181 (defun archive-ar-extract (archive name) |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2182 (let ((destbuf (current-buffer)) |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2183 (archivebuf (find-file-noselect archive)) |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2184 (from nil) size) |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2185 (with-current-buffer archivebuf |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2186 (save-restriction |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2187 ;; We may be in archive-mode or not, so either with or without |
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2188 ;; narrowing and with or without a prepended summary. |
102732
febdeb5803fd
(archive-ar-summarize): Don't burp on special GNU
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
100908
diff
changeset
|
2189 (save-excursion |
febdeb5803fd
(archive-ar-summarize): Don't burp on special GNU
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
100908
diff
changeset
|
2190 (widen) |
febdeb5803fd
(archive-ar-summarize): Don't burp on special GNU
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
100908
diff
changeset
|
2191 (search-forward "!<arch>\n") |
febdeb5803fd
(archive-ar-summarize): Don't burp on special GNU
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
100908
diff
changeset
|
2192 (while (and (not from) (looking-at archive-ar-file-header-re)) |
febdeb5803fd
(archive-ar-summarize): Don't burp on special GNU
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
100908
diff
changeset
|
2193 (let ((this (match-string 1))) |
febdeb5803fd
(archive-ar-summarize): Don't burp on special GNU
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
100908
diff
changeset
|
2194 (setq size (string-to-number (match-string 6))) |
febdeb5803fd
(archive-ar-summarize): Don't burp on special GNU
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
100908
diff
changeset
|
2195 (goto-char (match-end 0)) |
febdeb5803fd
(archive-ar-summarize): Don't burp on special GNU
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
100908
diff
changeset
|
2196 (if (equal name this) |
febdeb5803fd
(archive-ar-summarize): Don't burp on special GNU
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
100908
diff
changeset
|
2197 (setq from (point)) |
febdeb5803fd
(archive-ar-summarize): Don't burp on special GNU
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
100908
diff
changeset
|
2198 ;; Move to the end of the data. |
febdeb5803fd
(archive-ar-summarize): Don't burp on special GNU
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
100908
diff
changeset
|
2199 (forward-char size) (if (eq ?\n (char-after)) (forward-char 1))))) |
febdeb5803fd
(archive-ar-summarize): Don't burp on special GNU
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
100908
diff
changeset
|
2200 (when from |
febdeb5803fd
(archive-ar-summarize): Don't burp on special GNU
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
100908
diff
changeset
|
2201 (set-buffer-multibyte nil) |
febdeb5803fd
(archive-ar-summarize): Don't burp on special GNU
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
100908
diff
changeset
|
2202 (with-current-buffer destbuf |
febdeb5803fd
(archive-ar-summarize): Don't burp on special GNU
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
100908
diff
changeset
|
2203 ;; Do it within the `widen'. |
febdeb5803fd
(archive-ar-summarize): Don't burp on special GNU
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
100908
diff
changeset
|
2204 (insert-buffer-substring archivebuf from (+ from size))) |
febdeb5803fd
(archive-ar-summarize): Don't burp on special GNU
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
100908
diff
changeset
|
2205 (set-buffer-multibyte 'to) |
febdeb5803fd
(archive-ar-summarize): Don't burp on special GNU
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
100908
diff
changeset
|
2206 ;; Inform the caller that the call succeeded. |
febdeb5803fd
(archive-ar-summarize): Don't burp on special GNU
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
100908
diff
changeset
|
2207 t)))))) |
92538
30ee025de4a3
(archive-ar-file-header-re): New const.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
2208 |
11880 | 2209 ;; ------------------------------------------------------------------------- |
23467
dd5bbd8db2f5
(arc-mode): Provide arc-mode.
Richard M. Stallman <rms@gnu.org>
parents:
23383
diff
changeset
|
2210 ;; This line was a mistake; it is kept now for compatibility. |
dd5bbd8db2f5
(arc-mode): Provide arc-mode.
Richard M. Stallman <rms@gnu.org>
parents:
23383
diff
changeset
|
2211 ;; rms 15 Oct 98 |
11880 | 2212 (provide 'archive-mode) |
2213 | |
23467
dd5bbd8db2f5
(arc-mode): Provide arc-mode.
Richard M. Stallman <rms@gnu.org>
parents:
23383
diff
changeset
|
2214 (provide 'arc-mode) |
dd5bbd8db2f5
(arc-mode): Provide arc-mode.
Richard M. Stallman <rms@gnu.org>
parents:
23383
diff
changeset
|
2215 |
61414
9918f801db35
(archive-mode-map): Move initialization into
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55184
diff
changeset
|
2216 ;; arch-tag: e5966a01-35ec-4f27-8095-a043a79b457b |
38409
153f1b1f2efd
Emacs lisp coding convention fixes.
Pavel Janík <Pavel@Janik.cz>
parents:
38072
diff
changeset
|
2217 ;;; arc-mode.el ends here |