218 |
;; Zip archive configuration |
;; Zip archive configuration |
219 |
|
|
220 |
(defcustom archive-zip-extract |
(defcustom archive-zip-extract |
221 |
(if (locate-file "unzip" nil 'file-executable-p) |
(if (and (not (executable-find "unzip")) |
222 |
'("unzip" "-qq" "-c") |
(executable-find "pkunzip")) |
223 |
(if (locate-file "pkunzip" nil 'file-executable-p) |
'("pkunzip" "-e" "-o-") |
224 |
'("pkunzip" "-e" "-o-") |
'("unzip" "-qq" "-c")) |
|
'("unzip" "-qq" "-c"))) |
|
225 |
"*Program and its options to run in order to extract a zip file member. |
"*Program and its options to run in order to extract a zip file member. |
226 |
Extraction should happen to standard output. Archive and member name will |
Extraction should happen to standard output. Archive and member name will |
227 |
be added. If `archive-zip-use-pkzip' is non-nil then this program is |
be added. If `archive-zip-use-pkzip' is non-nil then this program is |
238 |
;; names. |
;; names. |
239 |
|
|
240 |
(defcustom archive-zip-expunge |
(defcustom archive-zip-expunge |
241 |
(if (locate-file "zip" nil 'file-executable-p) |
(if (and (not (executable-find "zip")) |
242 |
'("zip" "-d" "-q") |
(executable-find "pkzip")) |
243 |
(if (locate-file "pkzip" nil 'file-executable-p) |
'("pkzip" "-d") |
244 |
'("pkzip" "-d") |
'("zip" "-d" "-q")) |
|
'("zip" "-d" "-q"))) |
|
245 |
"*Program and its options to run in order to delete zip file members. |
"*Program and its options to run in order to delete zip file members. |
246 |
Archive and member names will be added." |
Archive and member names will be added." |
247 |
:type '(list (string :tag "Program") |
:type '(list (string :tag "Program") |
251 |
:group 'archive-zip) |
:group 'archive-zip) |
252 |
|
|
253 |
(defcustom archive-zip-update |
(defcustom archive-zip-update |
254 |
(if (locate-file "zip" nil 'file-executable-p) |
(if (and (not (executable-find "zip")) |
255 |
'("zip" "-q") |
(executable-find "pkzip")) |
256 |
(if (locate-file "pkzip" nil 'file-executable-p) |
'("pkzip" "-u" "-P") |
257 |
'("pkzip" "-u" "-P") |
'("zip" "-q")) |
|
'("zip" "-q"))) |
|
258 |
"*Program and its options to run in order to update a zip file member. |
"*Program and its options to run in order to update a zip file member. |
259 |
Options should ensure that specified directory will be put into the zip |
Options should ensure that specified directory will be put into the zip |
260 |
file. Archive and member name will be added." |
file. Archive and member name will be added." |
265 |
:group 'archive-zip) |
:group 'archive-zip) |
266 |
|
|
267 |
(defcustom archive-zip-update-case |
(defcustom archive-zip-update-case |
268 |
(if (locate-file "zip" nil 'file-executable-p) |
(if (and (not (executable-find "zip")) |
269 |
'("zip" "-q" "-k") |
(executable-find "pkzip")) |
270 |
(if (locate-file "pkzip" nil 'file-executable-p) |
'("pkzip" "-u" "-P") |
271 |
'("pkzip" "-u" "-P") |
'("zip" "-q" "-k")) |
|
'("zip" "-q" "-k"))) |
|
272 |
"*Program and its options to run in order to update a case fiddled zip member. |
"*Program and its options to run in order to update a case fiddled zip member. |
273 |
Options should ensure that specified directory will be put into the zip file. |
Options should ensure that specified directory will be put into the zip file. |
274 |
Archive and member name will be added." |
Archive and member name will be added." |
711 |
when parsing the archive." |
when parsing the archive." |
712 |
(widen) |
(widen) |
713 |
(set-buffer-multibyte nil) |
(set-buffer-multibyte nil) |
714 |
(let (buffer-read-only) |
(let ((inhibit-read-only t)) |
715 |
(or shut-up |
(or shut-up |
716 |
(message "Parsing archive file...")) |
(message "Parsing archive file...")) |
717 |
(buffer-disable-undo (current-buffer)) |
(buffer-disable-undo (current-buffer)) |
729 |
"Recreate the contents listing of an archive." |
"Recreate the contents listing of an archive." |
730 |
(let ((modified (buffer-modified-p)) |
(let ((modified (buffer-modified-p)) |
731 |
(no (archive-get-lineno)) |
(no (archive-get-lineno)) |
732 |
buffer-read-only) |
(inhibit-read-only t)) |
733 |
(widen) |
(widen) |
734 |
(delete-region (point-min) archive-proper-file-start) |
(delete-region (point-min) archive-proper-file-start) |
735 |
(archive-summarize t) |
(archive-summarize t) |
736 |
(set-buffer-modified-p modified) |
(restore-buffer-modified-p modified) |
737 |
(goto-char archive-file-list-start) |
(goto-char archive-file-list-start) |
738 |
(archive-next-line no))) |
(archive-next-line no))) |
739 |
|
|
828 |
(modified (buffer-modified-p)) |
(modified (buffer-modified-p)) |
829 |
(coding-system-for-read 'no-conversion) |
(coding-system-for-read 'no-conversion) |
830 |
(lno (archive-get-lineno)) |
(lno (archive-get-lineno)) |
831 |
buffer-read-only) |
(inhibit-read-only t)) |
832 |
(if unchanged nil |
(if unchanged nil |
833 |
(setq archive-files nil) |
(setq archive-files nil) |
834 |
(erase-buffer) |
(erase-buffer) |
928 |
(setq archive (archive-maybe-copy archive)) |
(setq archive (archive-maybe-copy archive)) |
929 |
(setq buffer (get-buffer-create bufname)) |
(setq buffer (get-buffer-create bufname)) |
930 |
(setq just-created t) |
(setq just-created t) |
931 |
(save-excursion |
(with-current-buffer buffer |
|
(set-buffer buffer) |
|
932 |
(setq buffer-file-name |
(setq buffer-file-name |
933 |
(expand-file-name (concat arcname ":" iname))) |
(expand-file-name (concat arcname ":" iname))) |
934 |
(setq buffer-file-truename |
(setq buffer-file-truename |
1051 |
(read-buffer "Buffer containing archive: " |
(read-buffer "Buffer containing archive: " |
1052 |
;; Find first archive buffer and suggest that |
;; Find first archive buffer and suggest that |
1053 |
(let ((bufs (buffer-list))) |
(let ((bufs (buffer-list))) |
1054 |
(while (and bufs (not (eq (save-excursion |
(while (and bufs |
1055 |
(set-buffer (car bufs)) |
(not (with-current-buffer (car bufs) |
1056 |
major-mode) |
(derived-mode-p 'archive-mode)))) |
1057 |
'archive-mode))) |
(setq bufs (cdr bufs))) |
|
(setq bufs (cdr bufs))) |
|
1058 |
(if bufs |
(if bufs |
1059 |
(car bufs) |
(car bufs) |
1060 |
(error "There are no archive buffers"))) |
(error "There are no archive buffers"))) |
1063 |
(if buffer-file-name |
(if buffer-file-name |
1064 |
(file-name-nondirectory buffer-file-name) |
(file-name-nondirectory buffer-file-name) |
1065 |
"")))) |
"")))) |
1066 |
(save-excursion |
(with-current-buffer arcbuf |
|
(set-buffer arcbuf) |
|
1067 |
(or (eq major-mode 'archive-mode) |
(or (eq major-mode 'archive-mode) |
1068 |
(error "Buffer is not an archive buffer")) |
(error "Buffer is not an archive buffer")) |
1069 |
(if archive-read-only |
(if archive-read-only |
1072 |
(error "An archive buffer cannot be added to itself")) |
(error "An archive buffer cannot be added to itself")) |
1073 |
(if (string= name "") |
(if (string= name "") |
1074 |
(error "Archive members may not be given empty names")) |
(error "Archive members may not be given empty names")) |
1075 |
(let ((func (save-excursion (set-buffer arcbuf) |
(let ((func (with-current-buffer arcbuf |
1076 |
(archive-name "add-new-member"))) |
(archive-name "add-new-member"))) |
1077 |
(membuf (current-buffer))) |
(membuf (current-buffer))) |
1078 |
(if (fboundp func) |
(if (fboundp func) |
1079 |
(save-excursion |
(with-current-buffer arcbuf |
|
(set-buffer arcbuf) |
|
1080 |
(funcall func buffer-file-name membuf name)) |
(funcall func buffer-file-name membuf name)) |
1081 |
(error "Adding a new member is not supported for this archive type")))) |
(error "Adding a new member is not supported for this archive type")))) |
1082 |
;; ------------------------------------------------------------------------- |
;; ------------------------------------------------------------------------- |
1087 |
(save-restriction |
(save-restriction |
1088 |
(message "Updating archive...") |
(message "Updating archive...") |
1089 |
(widen) |
(widen) |
1090 |
(let ((writer (save-excursion (set-buffer archive-superior-buffer) |
(let ((writer (with-current-buffer archive-superior-buffer |
1091 |
(archive-name "write-file-member"))) |
(archive-name "write-file-member"))) |
1092 |
(archive (save-excursion (set-buffer archive-superior-buffer) |
(archive (with-current-buffer archive-superior-buffer |
1093 |
(archive-maybe-copy (buffer-file-name))))) |
(archive-maybe-copy (buffer-file-name))))) |
1094 |
(if (fboundp writer) |
(if (fboundp writer) |
1095 |
(funcall writer archive archive-subfile-mode) |
(funcall writer archive archive-subfile-mode) |
1096 |
(archive-*-write-file-member archive |
(archive-*-write-file-member archive |
1159 |
(beginning-of-line) |
(beginning-of-line) |
1160 |
(let ((sign (if (>= p 0) +1 -1)) |
(let ((sign (if (>= p 0) +1 -1)) |
1161 |
(modified (buffer-modified-p)) |
(modified (buffer-modified-p)) |
1162 |
buffer-read-only) |
(inhibit-read-only t)) |
1163 |
(while (not (zerop p)) |
(while (not (zerop p)) |
1164 |
(if (archive-get-descr t) |
(if (archive-get-descr t) |
1165 |
(progn |
(progn |
1167 |
(insert type))) |
(insert type))) |
1168 |
(forward-line sign) |
(forward-line sign) |
1169 |
(setq p (- p sign))) |
(setq p (- p sign))) |
1170 |
(set-buffer-modified-p modified)) |
(restore-buffer-modified-p modified)) |
1171 |
(archive-next-line 0)) |
(archive-next-line 0)) |
1172 |
|
|
1173 |
(defun archive-unflag (p) |
(defun archive-unflag (p) |
1186 |
"Remove all marks." |
"Remove all marks." |
1187 |
(interactive) |
(interactive) |
1188 |
(let ((modified (buffer-modified-p)) |
(let ((modified (buffer-modified-p)) |
1189 |
buffer-read-only) |
(inhibit-read-only t)) |
1190 |
(save-excursion |
(save-excursion |
1191 |
(goto-char archive-file-list-start) |
(goto-char archive-file-list-start) |
1192 |
(while (< (point) archive-file-list-end) |
(while (< (point) archive-file-list-end) |
1193 |
(or (= (following-char) ? ) |
(or (= (following-char) ? ) |
1194 |
(progn (delete-char 1) (insert ? ))) |
(progn (delete-char 1) (insert ? ))) |
1195 |
(forward-line 1))) |
(forward-line 1))) |
1196 |
(set-buffer-modified-p modified))) |
(restore-buffer-modified-p modified))) |
1197 |
|
|
1198 |
(defun archive-mark (p) |
(defun archive-mark (p) |
1199 |
"In archive mode, mark this member for group operations. |
"In archive mode, mark this member for group operations. |
1331 |
"Undo in an archive buffer. |
"Undo in an archive buffer. |
1332 |
This doesn't recover lost files, it just undoes changes in the buffer itself." |
This doesn't recover lost files, it just undoes changes in the buffer itself." |
1333 |
(interactive) |
(interactive) |
1334 |
(let (buffer-read-only) |
(let ((inhibit-read-only t)) |
1335 |
(undo))) |
(undo))) |
1336 |
;; ------------------------------------------------------------------------- |
;; ------------------------------------------------------------------------- |
1337 |
;; Section: Arc Archives |
;; Section: Arc Archives |
1390 |
(error "File names in arc files are limited to 12 characters")) |
(error "File names in arc files are limited to 12 characters")) |
1391 |
(let ((name (concat newname (substring "\0\0\0\0\0\0\0\0\0\0\0\0\0" |
(let ((name (concat newname (substring "\0\0\0\0\0\0\0\0\0\0\0\0\0" |
1392 |
(length newname)))) |
(length newname)))) |
1393 |
buffer-read-only) |
(inhibit-read-only t)) |
1394 |
(save-restriction |
(save-restriction |
1395 |
(save-excursion |
(save-excursion |
1396 |
(widen) |
(widen) |
1562 |
(oldfnlen (char-after (+ p 21))) |
(oldfnlen (char-after (+ p 21))) |
1563 |
(newfnlen (length newname)) |
(newfnlen (length newname)) |
1564 |
(newhsize (+ oldhsize newfnlen (- oldfnlen))) |
(newhsize (+ oldhsize newfnlen (- oldfnlen))) |
1565 |
buffer-read-only) |
(inhibit-read-only t)) |
1566 |
(if (> newhsize 255) |
(if (> newhsize 255) |
1567 |
(error "The file name is too long")) |
(error "The file name is too long")) |
1568 |
(goto-char (+ p 21)) |
(goto-char (+ p 21)) |
1577 |
(save-excursion |
(save-excursion |
1578 |
(widen) |
(widen) |
1579 |
(set-buffer-multibyte nil) |
(set-buffer-multibyte nil) |
1580 |
(while files |
(dolist (fil files) |
1581 |
(let* ((fil (car files)) |
(let* ((p (+ archive-proper-file-start (aref fil 4))) |
|
(p (+ archive-proper-file-start (aref fil 4))) |
|
1582 |
(hsize (char-after p)) |
(hsize (char-after p)) |
1583 |
(fnlen (char-after (+ p 21))) |
(fnlen (char-after (+ p 21))) |
1584 |
(p2 (+ p 22 fnlen)) |
(p2 (+ p 22 fnlen)) |
1585 |
(creator (if (>= (- hsize fnlen) 24) (char-after (+ p2 2)) 0)) |
(creator (if (>= (- hsize fnlen) 24) (char-after (+ p2 2)) 0)) |
1586 |
buffer-read-only) |
(inhibit-read-only t)) |
1587 |
(if (= creator ?U) |
(if (= creator ?U) |
1588 |
(progn |
(progn |
1589 |
(or (numberp newval) |
(or (numberp newval) |
1595 |
(delete-char 1) |
(delete-char 1) |
1596 |
(insert (archive-lzh-resum (1+ p) hsize))) |
(insert (archive-lzh-resum (1+ p) hsize))) |
1597 |
(message "Member %s does not have %s field" |
(message "Member %s does not have %s field" |
1598 |
(aref fil 1) errtxt))) |
(aref fil 1) errtxt))))))) |
|
(setq files (cdr files)))))) |
|
1599 |
|
|
1600 |
(defun archive-lzh-chown-entry (newuid files) |
(defun archive-lzh-chown-entry (newuid files) |
1601 |
(archive-lzh-ogm newuid files "an uid" 10)) |
(archive-lzh-ogm newuid files "an uid" 10)) |
1699 |
(save-excursion |
(save-excursion |
1700 |
(widen) |
(widen) |
1701 |
(set-buffer-multibyte nil) |
(set-buffer-multibyte nil) |
1702 |
(while files |
(dolist (fil files) |
1703 |
(let* ((fil (car files)) |
(let* ((p (+ archive-proper-file-start (car (aref fil 4)))) |
|
(p (+ archive-proper-file-start (car (aref fil 4)))) |
|
1704 |
(creator (char-after (+ p 5))) |
(creator (char-after (+ p 5))) |
1705 |
(oldmode (aref fil 3)) |
(oldmode (aref fil 3)) |
1706 |
(newval (archive-calc-mode oldmode newmode t)) |
(newval (archive-calc-mode oldmode newmode t)) |
1707 |
buffer-read-only) |
(inhibit-read-only t)) |
1708 |
(cond ((memq creator '(2 3)) ; Unix + VMS |
(cond ((memq creator '(2 3)) ; Unix + VMS |
1709 |
(goto-char (+ p 40)) |
(goto-char (+ p 40)) |
1710 |
(delete-char 2) |
(delete-char 2) |
1715 |
(logand (logxor 1 (lsh newval -7)) 1))) |
(logand (logxor 1 (lsh newval -7)) 1))) |
1716 |
(delete-char 1)) |
(delete-char 1)) |
1717 |
(t (message "Don't know how to change mode for this member")))) |
(t (message "Don't know how to change mode for this member")))) |
1718 |
(setq files (cdr files)))))) |
)))) |
1719 |
;; ------------------------------------------------------------------------- |
;; ------------------------------------------------------------------------- |
1720 |
;; Section: Zoo Archives |
;; Section: Zoo Archives |
1721 |
|
|