;;; arc-mode.el --- simple editing of archives
;; Copyright (C) 1995, 1997, 1998, 2002, 2003, 2004,
-;; 2005 Free Software Foundation, Inc.
+;; 2005, 2006 Free Software Foundation, Inc.
;; Author: Morten Welinder <terra@gnu.org>
;; Keywords: archives msdog editing major-mode
(defsubst archive-name (suffix)
(intern (concat "archive-" (symbol-name archive-subtype) "-" suffix)))
-(defun archive-l-e (str &optional len)
+(defun archive-l-e (str &optional len float)
"Convert little endian string/vector STR to integer.
Alternatively, STR may be a buffer position in the current buffer
-in which case a second argument, length LEN, should be supplied."
+in which case a second argument, length LEN, should be supplied.
+FLOAT, if non-nil, means generate and return a float instead of an integer
+\(use this for numbers that can overflow the Emacs integer)."
(if (stringp str)
(setq len (length str))
(setq str (buffer-substring str (+ str len))))
(i 0))
(while (< i len)
(setq i (1+ i)
- result (+ (ash result 8) (aref str (- len i)))))
+ result (+ (if float (* result 256.0) (ash result 8))
+ (aref str (- len i)))))
result))
(defun archive-int-to-mode (mode)
(archive-name
(or (and archive-subfile-mode (aref archive-subfile-mode 0))
archive)))
- (make-directory archive-tmpdir t)
- ;; If ARCHIVE includes leading directories, make sure they
- ;; exist under archive-tmpdir.
- (let ((arch-dir (file-name-directory archive)))
- (if arch-dir
- (make-directory (concat
- (file-name-as-directory archive-tmpdir)
- arch-dir)
- t)))
(setq archive-local-name
(archive-unique-fname archive-name archive-tmpdir))
+ ;; Maked sure all the leading directories in
+ ;; archive-local-name exist under archive-tmpdir, so that
+ ;; the directory structure recorded in the archive is
+ ;; reconstructed in the temporary directory.
+ (make-directory (file-name-directory archive-local-name) t)
(save-restriction
(widen)
(write-region start (point-max) archive-local-name nil 'nomessage))
"Set the current buffer as if it were visiting FILENAME."
(save-excursion
(goto-char (point-min))
- (let ((coding
+ (let ((buffer-undo-list t)
+ (coding
(or coding-system-for-read
(and set-auto-coding-function
(save-excursion
;; extracted file existed.
(let ((file-name-handler-alist
'(("" . archive-file-name-handler))))
- (car (find-operation-coding-system 'insert-file-contents
- filename t))))))
+ (car (find-operation-coding-system
+ 'insert-file-contents
+ (cons filename (current-buffer)) t))))))
(if (and (not coding-system-for-read)
(not enable-multibyte-characters))
(setq coding
(read-only-p (or archive-read-only
view-p
(string-match file-name-invalid-regexp ename)))
+ (arcfilename (expand-file-name (concat arcname ":" iname)))
(buffer (get-buffer bufname))
(just-created nil)
(file-name-coding archive-file-name-coding-system))
- (if buffer
+ (if (and buffer
+ (string= (buffer-file-name buffer) arcfilename))
nil
(setq archive (archive-maybe-copy archive))
+ (setq bufname (generate-new-buffer-name bufname))
(setq buffer (get-buffer-create bufname))
(setq just-created t)
(with-current-buffer buffer
- (setq buffer-file-name
- (expand-file-name (concat arcname ":" iname)))
+ (setq buffer-file-name arcfilename)
(setq buffer-file-truename
(abbreviate-file-name buffer-file-name))
;; Set the default-directory to the dir of the superior buffer.
(fnlen (or (string-match "\0" namefld) 13))
(efnname (decode-coding-string (substring namefld 0 fnlen)
archive-file-name-coding-system))
- (csize (archive-l-e (+ p 15) 4))
+ ;; Convert to float to avoid overflow for very large files.
+ (csize (archive-l-e (+ p 15) 4 'float))
(moddate (archive-l-e (+ p 19) 2))
(modtime (archive-l-e (+ p 21) 2))
- (ucsize (archive-l-e (+ p 25) 4))
+ (ucsize (archive-l-e (+ p 25) 4 'float))
(fiddle (string= efnname (upcase efnname)))
(ifnname (if fiddle (downcase efnname) efnname))
- (text (format " %8d %-11s %-8s %s"
+ (text (format " %8.0f %-11s %-8s %s"
ucsize
(archive-dosdate moddate)
(archive-dostime modtime)
visual)
files (cons (vector efnname ifnname fiddle nil (1- p))
files)
- p (+ p 29 csize))))
+ ;; p needs to stay an integer, since we use it in char-after
+ ;; above. Passing through `round' limits the compressed size
+ ;; to most-positive-fixnum, but if the compressed size exceeds
+ ;; that, we cannot visit the archive anyway.
+ p (+ p 29 (round csize)))))
(goto-char (point-min))
(let ((dash (concat "- -------- ----------- -------- "
(make-string maxlen ?-)
dash)
(archive-summarize-files (nreverse visual))
(insert dash
- (format " %8d %d file%s"
+ (format " %8.0f %d file%s"
totalsize
(length files)
(if (= 1 (length files)) "" "s"))
(while (progn (goto-char p) ;beginning of a base header.
(looking-at "\\(.\\|\n\\)\\(.\\|\n\\)-l[hz][0-9ds]-"))
(let* ((hsize (byte-after p)) ;size of the base header (level 0 and 1)
- (csize (archive-l-e (+ p 7) 4)) ;size of a compressed file to follow (level 0 and 2),
+ ;; Convert to float to avoid overflow for very large files.
+ (csize (archive-l-e (+ p 7) 4 'float)) ;size of a compressed file to follow (level 0 and 2),
;size of extended headers + the compressed file to follow (level 1).
- (ucsize (archive-l-e (+ p 11) 4)) ;size of an uncompressed file.
+ (ucsize (archive-l-e (+ p 11) 4 'float)) ;size of an uncompressed file.
(time1 (archive-l-e (+ p 15) 2)) ;date/time (MSDOS format in level 0, 1 headers
(time2 (archive-l-e (+ p 17) 2)) ;and UNIX format in level 2 header.)
(hdrlvl (byte-after (+ p 20))) ;header level
(archive-unixtime time1 time2)
(archive-dostime time1)))
(setq text (if archive-alternate-display
- (format " %8d %5S %5S %s"
+ (format " %8.0f %5S %5S %s"
ucsize
(or uid "?")
(or gid "?")
ifnname)
- (format " %10s %8d %-11s %-8s %s"
+ (format " %10s %8.0f %-11s %-8s %s"
modestr
ucsize
moddate
files (cons (vector prname ifnname fiddle mode (1- p))
files))
(cond ((= hdrlvl 1)
- (setq p (+ p hsize 2 csize)))
+ ;; p needs to stay an integer, since we use it in goto-char
+ ;; above. Passing through `round' limits the compressed size
+ ;; to most-positive-fixnum, but if the compressed size exceeds
+ ;; that, we cannot visit the archive anyway.
+ (setq p (+ p hsize 2 (round csize))))
((or (= hdrlvl 2) (= hdrlvl 0))
- (setq p (+ p thsize 2 csize))))
+ (setq p (+ p thsize 2 (round csize)))))
))
(goto-char (point-min))
(let ((dash (concat (if archive-alternate-display
"M Length Uid Gid File\n"
"M Filemode Length Date Time File\n"))
(sumline (if archive-alternate-display
- " %8d %d file%s"
- " %8d %d file%s")))
+ " %8.0f %d file%s"
+ " %8.0f %d file%s")))
(insert header dash)
(archive-summarize-files (nreverse visual))
(insert dash
;; (method (archive-l-e (+ p 10) 2))
(modtime (archive-l-e (+ p 12) 2))
(moddate (archive-l-e (+ p 14) 2))
- (ucsize (archive-l-e (+ p 24) 4))
+ ;; Convert to float to avoid overflow for very large files.
+ (ucsize (archive-l-e (+ p 24) 4 'float))
(fnlen (archive-l-e (+ p 28) 2))
(exlen (archive-l-e (+ p 30) 2))
(fclen (archive-l-e (+ p 32) 2))
(string= (upcase efnname) efnname)))
(ifnname (if fiddle (downcase efnname) efnname))
(width (string-width ifnname))
- (text (format " %10s %8d %-11s %-8s %s"
+ (text (format " %10s %8.0f %-11s %-8s %s"
modestr
ucsize
(archive-dosdate moddate)
dash)
(archive-summarize-files (nreverse visual))
(insert dash
- (format " %8d %d file%s"
+ (format " %8.0f %d file%s"
totalsize
(length files)
(if (= 1 (length files)) "" "s"))
(let* ((next (1+ (archive-l-e (+ p 6) 4)))
(moddate (archive-l-e (+ p 14) 2))
(modtime (archive-l-e (+ p 16) 2))
- (ucsize (archive-l-e (+ p 20) 4))
+ ;; Convert to float to avoid overflow for very large files.
+ (ucsize (archive-l-e (+ p 20) 4 'float))
(namefld (buffer-substring (+ p 38) (+ p 38 13)))
(dirtype (byte-after (+ p 4)))
(lfnlen (if (= dirtype 2) (byte-after (+ p 56)) 0))
(fiddle (and (= lfnlen 0) (string= efnname (upcase efnname))))
(ifnname (if fiddle (downcase efnname) efnname))
(width (string-width ifnname))
- (text (format " %8d %-11s %-8s %s"
+ (text (format " %8.0f %-11s %-8s %s"
ucsize
(archive-dosdate moddate)
(archive-dostime modtime)
dash)
(archive-summarize-files (nreverse visual))
(insert dash
- (format " %8d %d file%s"
+ (format " %8.0f %d file%s"
totalsize
(length files)
(if (= 1 (length files)) "" "s"))