annotate lisp/arc-mode.el @ 94969:916f0f042c9e

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