diff options
Diffstat (limited to 'lisp/arc-mode.el')
| -rw-r--r-- | lisp/arc-mode.el | 327 |
1 files changed, 145 insertions, 182 deletions
diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index 0e4ee525db1..7f435f17a17 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -417,70 +417,66 @@ file. Archive and member name will be added." (substitute-key-definition 'advertised-undo 'archive-undo map global-map) (substitute-key-definition 'undo 'archive-undo map global-map)) - (define-key map - (if (featurep 'xemacs) 'button2 [mouse-2]) 'archive-extract) - - (if (featurep 'xemacs) - () ; out of luck - - (define-key map [menu-bar immediate] - (cons "Immediate" (make-sparse-keymap "Immediate"))) - (define-key map [menu-bar immediate alternate] - '(menu-item "Alternate Display" archive-alternate-display - :enable (boundp (archive-name "alternate-display")) - :help "Toggle alternate file info display")) - (define-key map [menu-bar immediate view] - '(menu-item "View This File" archive-view - :help "Display file at cursor in View Mode")) - (define-key map [menu-bar immediate display] - '(menu-item "Display in Other Window" archive-display-other-window - :help "Display file at cursor in another window")) - (define-key map [menu-bar immediate find-file-other-window] - '(menu-item "Find in Other Window" archive-extract-other-window - :help "Edit file at cursor in another window")) - (define-key map [menu-bar immediate find-file] - '(menu-item "Find This File" archive-extract - :help "Extract file at cursor and edit it")) - - (define-key map [menu-bar mark] - (cons "Mark" (make-sparse-keymap "Mark"))) - (define-key map [menu-bar mark unmark-all] - '(menu-item "Unmark All" archive-unmark-all-files - :help "Unmark all marked files")) - (define-key map [menu-bar mark deletion] - '(menu-item "Flag" archive-flag-deleted - :help "Flag file at cursor for deletion")) - (define-key map [menu-bar mark unmark] - '(menu-item "Unflag" archive-unflag - :help "Unmark file at cursor")) - (define-key map [menu-bar mark mark] - '(menu-item "Mark" archive-mark - :help "Mark file at cursor")) - - (define-key map [menu-bar operate] - (cons "Operate" (make-sparse-keymap "Operate"))) - (define-key map [menu-bar operate chown] - '(menu-item "Change Owner..." archive-chown-entry - :enable (fboundp (archive-name "chown-entry")) - :help "Change owner of marked files")) - (define-key map [menu-bar operate chgrp] - '(menu-item "Change Group..." archive-chgrp-entry - :enable (fboundp (archive-name "chgrp-entry")) - :help "Change group ownership of marked files")) - (define-key map [menu-bar operate chmod] - '(menu-item "Change Mode..." archive-chmod-entry - :enable (fboundp (archive-name "chmod-entry")) - :help "Change mode (permissions) of marked files")) - (define-key map [menu-bar operate rename] - '(menu-item "Rename to..." archive-rename-entry - :enable (fboundp (archive-name "rename-entry")) - :help "Rename marked files")) - ;;(define-key map [menu-bar operate copy] - ;; '(menu-item "Copy to..." archive-copy)) - (define-key map [menu-bar operate expunge] - '(menu-item "Expunge Marked Files" archive-expunge - :help "Delete all flagged files from archive")) - map)) + (define-key map [mouse-2] 'archive-extract) + + (define-key map [menu-bar immediate] + (cons "Immediate" (make-sparse-keymap "Immediate"))) + (define-key map [menu-bar immediate alternate] + '(menu-item "Alternate Display" archive-alternate-display + :enable (boundp (archive-name "alternate-display")) + :help "Toggle alternate file info display")) + (define-key map [menu-bar immediate view] + '(menu-item "View This File" archive-view + :help "Display file at cursor in View Mode")) + (define-key map [menu-bar immediate display] + '(menu-item "Display in Other Window" archive-display-other-window + :help "Display file at cursor in another window")) + (define-key map [menu-bar immediate find-file-other-window] + '(menu-item "Find in Other Window" archive-extract-other-window + :help "Edit file at cursor in another window")) + (define-key map [menu-bar immediate find-file] + '(menu-item "Find This File" archive-extract + :help "Extract file at cursor and edit it")) + + (define-key map [menu-bar mark] + (cons "Mark" (make-sparse-keymap "Mark"))) + (define-key map [menu-bar mark unmark-all] + '(menu-item "Unmark All" archive-unmark-all-files + :help "Unmark all marked files")) + (define-key map [menu-bar mark deletion] + '(menu-item "Flag" archive-flag-deleted + :help "Flag file at cursor for deletion")) + (define-key map [menu-bar mark unmark] + '(menu-item "Unflag" archive-unflag + :help "Unmark file at cursor")) + (define-key map [menu-bar mark mark] + '(menu-item "Mark" archive-mark + :help "Mark file at cursor")) + + (define-key map [menu-bar operate] + (cons "Operate" (make-sparse-keymap "Operate"))) + (define-key map [menu-bar operate chown] + '(menu-item "Change Owner..." archive-chown-entry + :enable (fboundp (archive-name "chown-entry")) + :help "Change owner of marked files")) + (define-key map [menu-bar operate chgrp] + '(menu-item "Change Group..." archive-chgrp-entry + :enable (fboundp (archive-name "chgrp-entry")) + :help "Change group ownership of marked files")) + (define-key map [menu-bar operate chmod] + '(menu-item "Change Mode..." archive-chmod-entry + :enable (fboundp (archive-name "chmod-entry")) + :help "Change mode (permissions) of marked files")) + (define-key map [menu-bar operate rename] + '(menu-item "Rename to..." archive-rename-entry + :enable (fboundp (archive-name "rename-entry")) + :help "Rename marked files")) + ;;(define-key map [menu-bar operate copy] + ;; '(menu-item "Copy to..." archive-copy)) + (define-key map [menu-bar operate expunge] + '(menu-item "Expunge Marked Files" archive-expunge + :help "Delete all flagged files from archive")) + map) "Local keymap for archive mode listings.") (defvar archive-file-name-indent nil "Column where file names start.") @@ -516,36 +512,30 @@ Each descriptor is a vector of the form ;; ------------------------------------------------------------------------- ;;; Section: Support functions. -(eval-when-compile - (defsubst byte-after (pos) - "Like char-after but an eight-bit char is converted to unibyte." - (multibyte-char-to-unibyte (char-after pos))) - (defsubst insert-unibyte (&rest args) - "Like insert but don't make unibyte string and eight-bit char multibyte." - (dolist (elt args) - (if (integerp elt) - (insert (if (< elt 128) elt (decode-char 'eight-bit elt))) - (insert (string-to-multibyte elt))))) - ) +(defun arc-insert-unibyte (&rest args) + "Like insert but don't make unibyte string and eight-bit char multibyte." + (dolist (elt args) + (if (integerp elt) + (insert (if (< elt 128) elt (decode-char 'eight-bit elt))) + (insert elt)))) (defsubst archive-name (suffix) (intern (concat "archive-" (symbol-name archive-subtype) "-" suffix))) -(defun archive-l-e (str &optional len float) +(defun archive-l-e (str &optional len) "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. -FLOAT, if non-nil, means generate and return a float instead of an integer -\(use this for numbers that can overflow the Emacs integer)." +in which case a second argument, length LEN, should be supplied." (if (stringp str) (setq len (length str)) (setq str (buffer-substring str (+ str len)))) - (setq str (string-as-unibyte str)) + (if (multibyte-string-p str) + (setq str (encode-coding-string str 'utf-8-emacs-unix))) (let ((result 0) (i 0)) (while (< i len) (setq i (1+ i) - result (+ (if float (* result 256.0) (ash result 8)) + result (+ (ash result 8) (aref str (- len i))))) result)) @@ -583,7 +573,7 @@ the mode is invalid. If ERROR is nil then nil will be returned." (len (length newmode)) (i 1)) (while (< i len) - (setq result (+ (lsh result 3) (aref newmode i) (- ?0)) + (setq result (+ (ash result 3) (aref newmode i) (- ?0)) i (1+ i))) (logior (logand oldmode 65024) result))) ((string-match "^\\([agou]+\\)\\([---+=]\\)\\([rwxst]+\\)$" newmode) @@ -639,7 +629,7 @@ the mode is invalid. If ERROR is nil then nil will be returned." (defun archive-unixdate (low high) "Stringify Unix (LOW HIGH) date." - (let* ((time (cons high low)) + (let* ((time (list high low)) (str (current-time-string time))) (format "%s-%s-%s" (substring str 8 10) @@ -648,8 +638,7 @@ the mode is invalid. If ERROR is nil then nil will be returned." (defun archive-unixtime (low high) "Stringify Unix (LOW HIGH) time." - (let ((str (current-time-string (cons high low)))) - (substring str 11 19))) + (format-time-string "%H:%M:%S" (list high low))) (defun archive-get-lineno () (if (>= (point) archive-file-list-start) @@ -748,8 +737,7 @@ archive. (or file-name-coding-system default-file-name-coding-system locale-coding-system)) - (if (default-value 'enable-multibyte-characters) - (set-buffer-multibyte 'to)) + (set-buffer-multibyte 'to) (archive-summarize nil) (setq buffer-read-only t) (when (and archive-visit-single-files @@ -807,7 +795,7 @@ is visible (and the real data of the buffer is hidden). Optional argument SHUT-UP, if non-nil, means don't print messages when parsing the archive." (widen) - (let ((buffer-file-truename nil) ; avoid changing dir mtime by lock_file + (let ((create-lockfiles nil) ; avoid changing dir mtime by lock_file (inhibit-read-only t)) (setq archive-proper-file-start (copy-marker (point-min) t)) (set (make-local-variable 'change-major-mode-hook) 'archive-desummarize) @@ -846,13 +834,11 @@ when parsing the archive." ;; Using `concat' here copies the text also, so we can add ;; properties without problems. (let ((text (concat (aref fil 0) "\n"))) - (if (featurep 'xemacs) - () ; out of luck - (add-text-properties - (aref fil 1) (aref fil 2) - '(mouse-face highlight - help-echo "mouse-2: extract this file into a buffer") - text)) + (add-text-properties + (aref fil 1) (aref fil 2) + '(mouse-face highlight + help-echo "mouse-2: extract this file into a buffer") + text) text)) files))) (setq archive-file-list-end (point-marker))) @@ -972,8 +958,8 @@ using `make-temp-file', and the generated name is returned." (jka-compr-inhibit t)) (write-region (point-min) (point-max) tmpfile nil 'quiet)) (erase-buffer) - (let ((coding-system-for-read 'no-conversion)) - (insert-file-contents tmpfile))) + (set-buffer-multibyte t) + (insert-file-contents tmpfile)) (delete-file tmpfile))))) (defun archive-file-name-handler (op &rest args) @@ -1011,8 +997,6 @@ using `make-temp-file', and the generated name is returned." (kill-local-variable 'buffer-file-coding-system) (after-insert-file-set-coding (- (point-max) (point-min)))))) -(define-obsolete-function-alias 'archive-mouse-extract 'archive-extract "22.1") - (defun archive-extract (&optional other-window-p event) "In archive mode, extract this entry of the archive into its own buffer." (interactive (list nil last-input-event)) @@ -1064,7 +1048,9 @@ using `make-temp-file', and the generated name is returned." ;; We read an archive member by no-conversion at ;; first, then decode appropriately by calling ;; archive-set-buffer-as-visiting-file later. - (coding-system-for-read 'no-conversion)) + (coding-system-for-read 'no-conversion) + ;; Avoid changing dir mtime by lock_file + (create-lockfiles nil)) (condition-case err (if (fboundp extractor) (funcall extractor archive ename) @@ -1496,20 +1482,19 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." files visual) (while (and (< (+ p 29) (point-max)) - (= (byte-after p) ?\C-z) - (> (byte-after (1+ p)) 0)) + (= (get-byte p) ?\C-z) + (> (get-byte (1+ p)) 0)) (let* ((namefld (buffer-substring (+ p 2) (+ p 2 13))) (fnlen (or (string-match "\0" namefld) 13)) (efnname (decode-coding-string (substring namefld 0 fnlen) archive-file-name-coding-system)) - ;; Convert to float to avoid overflow for very large files. - (csize (archive-l-e (+ p 15) 4 'float)) + (csize (archive-l-e (+ p 15) 4)) (moddate (archive-l-e (+ p 19) 2)) (modtime (archive-l-e (+ p 21) 2)) - (ucsize (archive-l-e (+ p 25) 4 'float)) + (ucsize (archive-l-e (+ p 25) 4)) (fiddle (string= efnname (upcase efnname))) (ifnname (if fiddle (downcase efnname) efnname)) - (text (format " %8.0f %-11s %-8s %s" + (text (format " %8d %-11s %-8s %s" ucsize (archive-dosdate moddate) (archive-dostime modtime) @@ -1522,11 +1507,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." visual) files (cons (vector efnname ifnname fiddle nil (1- p)) files) - ;; 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))))) + p (+ p 29 csize)))) (goto-char (point-min)) (let ((dash (concat "- -------- ----------- -------- " (make-string maxlen ?-) @@ -1535,7 +1516,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." dash) (archive-summarize-files (nreverse visual)) (insert dash - (format " %8.0f %d file%s" + (format " %8d %d file%s" totalsize (length files) (if (= 1 (length files)) "" "s")) @@ -1543,7 +1524,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (apply #'vector (nreverse files)))) (defun archive-arc-rename-entry (newname descr) - (if (string-match "[:\\\\/]" newname) + (if (string-match "[:\\/]" newname) (error "File names in arc files must not contain a directory component")) (if (> (length newname) 12) (error "File names in arc files are limited to 12 characters")) @@ -1555,7 +1536,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (widen) (goto-char (+ archive-proper-file-start (aref descr 4) 2)) (delete-char 13) - (insert-unibyte name))))) + (arc-insert-unibyte name))))) ;; ------------------------------------------------------------------------- ;;; Section: Lzh Archives @@ -1567,14 +1548,13 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." visual) (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) - ;; 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), + (let* ((hsize (get-byte 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), ;size of extended headers + the compressed file to follow (level 1). - (ucsize (archive-l-e (+ p 11) 4 'float)) ;size of an uncompressed file. + (ucsize (archive-l-e (+ p 11) 4)) ;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 + (hdrlvl (get-byte (+ p 20))) ;header level thsize ;total header size (base + extensions) fnlen efnname osid fiddle ifnname width p2 neh ;beginning of next extension header (level 1 and 2) @@ -1582,7 +1562,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." gname uname modtime moddate) (if (= hdrlvl 3) (error "can't handle lzh level 3 header type")) (when (or (= hdrlvl 0) (= hdrlvl 1)) - (setq fnlen (byte-after (+ p 21))) ;filename length + (setq fnlen (get-byte (+ p 21))) ;filename length (setq efnname (let ((str (buffer-substring (+ p 22) (+ p 22 fnlen)))) ;filename from offset 22 (decode-coding-string str archive-file-name-coding-system))) @@ -1593,19 +1573,19 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (setq neh (+ p 24)))) ;specific to level 2 header (if neh ;if level 1 or 2 we expect extension headers to follow (let* ((ehsize (archive-l-e neh 2)) ;size of the extension header - (etype (byte-after (+ neh 2)))) ;extension type + (etype (get-byte (+ neh 2)))) ;extension type (while (not (= ehsize 0)) (cond ((= etype 1) ;file name (let ((i (+ neh 3))) (while (< i (+ neh ehsize)) - (setq efnname (concat efnname (char-to-string (byte-after i)))) + (setq efnname (concat efnname (char-to-string (get-byte i)))) (setq i (1+ i))))) ((= etype 2) ;directory name (let ((i (+ neh 3))) (while (< i (+ neh ehsize)) (setq dir (concat dir - (if (= (byte-after i) + (if (= (get-byte i) 255) "/" (char-to-string @@ -1629,7 +1609,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." ) (setq neh (+ neh ehsize)) (setq ehsize (archive-l-e neh 2)) - (setq etype (byte-after (+ neh 2)))) + (setq etype (get-byte (+ neh 2)))) ;;get total header size for level 1 and 2 headers (setq thsize (- neh p)))) (if (= hdrlvl 0) ;total header size @@ -1661,12 +1641,12 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (archive-unixtime time1 time2) (archive-dostime time1))) (setq text (if archive-alternate-display - (format " %8.0f %5S %5S %s" + (format " %8d %5S %5S %s" ucsize (or uid "?") (or gid "?") ifnname) - (format " %10s %8.0f %-11s %-8s %s" + (format " %10s %8d %-11s %-8s %s" modestr ucsize moddate @@ -1681,13 +1661,9 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." files (cons (vector prname ifnname fiddle mode (1- p)) files)) (cond ((= hdrlvl 1) - ;; 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)))) + (setq p (+ p hsize 2 csize))) ((or (= hdrlvl 2) (= hdrlvl 0)) - (setq p (+ p thsize 2 (round csize))))) + (setq p (+ p thsize 2 csize)))) )) (goto-char (point-min)) (let ((dash (concat (if archive-alternate-display @@ -1720,7 +1696,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (let ((sum 0)) (while (> count 0) (setq count (1- count) - sum (+ sum (byte-after p)) + sum (+ sum (get-byte p)) p (1+ p))) (logand sum 255))) @@ -1729,8 +1705,8 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (save-excursion (widen) (let* ((p (+ archive-proper-file-start (aref descr 4))) - (oldhsize (byte-after p)) - (oldfnlen (byte-after (+ p 21))) + (oldhsize (get-byte p)) + (oldfnlen (get-byte (+ p 21))) (newfnlen (length newname)) (newhsize (+ oldhsize newfnlen (- oldfnlen))) (inhibit-read-only t)) @@ -1738,10 +1714,10 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (error "The file name is too long")) (goto-char (+ p 21)) (delete-char (1+ oldfnlen)) - (insert-unibyte newfnlen newname) + (arc-insert-unibyte newfnlen newname) (goto-char p) (delete-char 2) - (insert-unibyte newhsize (archive-lzh-resum p newhsize)))))) + (arc-insert-unibyte newhsize (archive-lzh-resum p newhsize)))))) (defun archive-lzh-ogm (newval files errtxt ofs) (save-excursion @@ -1749,10 +1725,10 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (widen) (dolist (fil files) (let* ((p (+ archive-proper-file-start (aref fil 4))) - (hsize (byte-after p)) - (fnlen (byte-after (+ p 21))) + (hsize (get-byte p)) + (fnlen (get-byte (+ p 21))) (p2 (+ p 22 fnlen)) - (creator (if (>= (- hsize fnlen) 24) (byte-after (+ p2 2)) 0)) + (creator (if (>= (- hsize fnlen) 24) (get-byte (+ p2 2)) 0)) (inhibit-read-only t)) (if (= creator ?U) (progn @@ -1760,10 +1736,10 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (setq newval (funcall newval (archive-l-e (+ p2 ofs) 2)))) (goto-char (+ p2 ofs)) (delete-char 2) - (insert-unibyte (logand newval 255) (lsh newval -8)) + (arc-insert-unibyte (logand newval 255) (ash newval -8)) (goto-char (1+ p)) (delete-char 1) - (insert-unibyte (archive-lzh-resum (1+ p) hsize))) + (arc-insert-unibyte (archive-lzh-resum (1+ p) hsize))) (message "Member %s does not have %s field" (aref fil 1) errtxt))))))) @@ -1825,32 +1801,21 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." ;; ;; First, find the Zip64 end-of-central-directory locator. (search-backward "PK\006\007") - ;; Pay attention: the offset of Zip64 end-of-central-directory - ;; is a 64-bit field, so it could overflow the Emacs integer - ;; even on a 64-bit host, let alone 32-bit one. But since we've - ;; already read the zip file into a buffer, and this is a byte - ;; offset into the file we've read, it must be short enough, so - ;; such an overflow can never happen, and we can safely read - ;; these 8 bytes into an Emacs integer. Moreover, on host with - ;; 32-bit Emacs integer we can only read 4 bytes, since they are - ;; stored in little-endian byte order. - (setq emacs-int-has-32bits (<= most-positive-fixnum #x1fffffff)) (setq p (+ (point-min) - (archive-l-e (+ (point) 8) (if emacs-int-has-32bits 4 8)))) + (archive-l-e (+ (point) 8) 8))) (goto-char p) ;; We should be at Zip64 end-of-central-directory record now. (or (string= "PK\006\006" (buffer-substring p (+ p 4))) (error "Unrecognized ZIP file format")) ;; Offset to central directory: - (setq p (archive-l-e (+ p 48) (if emacs-int-has-32bits 4 8)))) + (setq p (archive-l-e (+ p 48) 8))) (setq p (+ p (point-min))) (while (string= "PK\001\002" (buffer-substring p (+ p 4))) - (let* ((creator (byte-after (+ p 5))) + (let* ((creator (get-byte (+ p 5))) ;; (method (archive-l-e (+ p 10) 2)) (modtime (archive-l-e (+ p 12) 2)) (moddate (archive-l-e (+ p 14) 2)) - ;; Convert to float to avoid overflow for very large files. - (ucsize (archive-l-e (+ p 24) 4 'float)) + (ucsize (archive-l-e (+ p 24) 4)) (fnlen (archive-l-e (+ p 28) 2)) (exlen (archive-l-e (+ p 30) 2)) (fclen (archive-l-e (+ p 32) 2)) @@ -1866,7 +1831,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (logior ?\444 (if isdir (logior 16384 ?\111) 0) (if (zerop - (logand 1 (byte-after (+ p 38)))) + (logand 1 (get-byte (+ p 38)))) ?\222 0))) (t nil))) (modestr (if mode (archive-int-to-mode mode) "??????????")) @@ -1875,7 +1840,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (string= (upcase efnname) efnname))) (ifnname (if fiddle (downcase efnname) efnname)) (width (string-width ifnname)) - (text (format " %10s %8.0f %-11s %-8s %s" + (text (format " %10s %8d %-11s %-8s %s" modestr ucsize (archive-dosdate moddate) @@ -1901,7 +1866,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." dash) (archive-summarize-files (nreverse visual)) (insert dash - (format " %8.0f %d file%s" + (format " %8d %d file%s" totalsize (length files) (if (= 1 (length files)) "" "s")) @@ -1943,18 +1908,19 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (widen) (dolist (fil files) (let* ((p (+ archive-proper-file-start (car (aref fil 4)))) - (creator (byte-after (+ p 5))) + (creator (get-byte (+ p 5))) (oldmode (aref fil 3)) (newval (archive-calc-mode oldmode newmode t)) (inhibit-read-only t)) (cond ((memq creator '(2 3)) ; Unix (goto-char (+ p 40)) (delete-char 2) - (insert-unibyte (logand newval 255) (lsh newval -8))) + (arc-insert-unibyte (logand newval 255) (ash newval -8))) ((memq creator '(0 5 6 7 10 11 15)) ; Dos etc. (goto-char (+ p 38)) - (insert-unibyte (logior (logand (byte-after (point)) 254) - (logand (logxor 1 (lsh newval -7)) 1))) + (arc-insert-unibyte + (logior (logand (get-byte (point)) 254) + (logand (logxor 1 (ash newval -7)) 1))) (delete-char 1)) (t (message "Don't know how to change mode for this member")))) )))) @@ -1972,12 +1938,11 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (let* ((next (1+ (archive-l-e (+ p 6) 4))) (moddate (archive-l-e (+ p 14) 2)) (modtime (archive-l-e (+ p 16) 2)) - ;; Convert to float to avoid overflow for very large files. - (ucsize (archive-l-e (+ p 20) 4 'float)) + (ucsize (archive-l-e (+ p 20) 4)) (namefld (buffer-substring (+ p 38) (+ p 38 13))) - (dirtype (byte-after (+ p 4))) - (lfnlen (if (= dirtype 2) (byte-after (+ p 56)) 0)) - (ldirlen (if (= dirtype 2) (byte-after (+ p 57)) 0)) + (dirtype (get-byte (+ p 4))) + (lfnlen (if (= dirtype 2) (get-byte (+ p 56)) 0)) + (ldirlen (if (= dirtype 2) (get-byte (+ p 57)) 0)) (fnlen (or (string-match "\0" namefld) 13)) (efnname (let ((str (concat @@ -1996,7 +1961,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (fiddle (and (= lfnlen 0) (string= efnname (upcase efnname)))) (ifnname (if fiddle (downcase efnname) efnname)) (width (string-width ifnname)) - (text (format " %8.0f %-11s %-8s %s" + (text (format " %8d %-11s %-8s %s" ucsize (archive-dosdate moddate) (archive-dostime modtime) @@ -2018,7 +1983,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." dash) (archive-summarize-files (nreverse visual)) (insert dash - (format " %8.0f %d file%s" + (format " %8d %d file%s" totalsize (length files) (if (= 1 (length files)) "" "s")) @@ -2042,14 +2007,14 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (call-process "lsar" nil t nil "-l" (or file copy)) (if copy (delete-file copy)) (goto-char (point-min)) - (re-search-forward "^\\(\s+=+\s?+\\)+\n") - (while (looking-at (concat "^\s+[0-9.]+\s+-+\s+" ; Flags - "\\([0-9-]+\\)\s+" ; Size - "\\([0-9.%]+\\)\s+" ; Ratio - "\\([0-9a-zA-Z]+\\)\s+" ; Mode - "\\([0-9-]+\\)\s+" ; Date - "\\([0-9:]+\\)\s+" ; Time - "\\(.*\\)\n" ; Name + (re-search-forward "^\\(\s+=+\s*\\)+\n") + (while (looking-at (concat "^\s+[0-9.]+\s+D?-+\s+" ; Flags + "\\([0-9-]+\\)\s+" ; Size + "\\([-0-9.%]+\\)\s+" ; Ratio + "\\([0-9a-zA-Z]+\\)\s+" ; Mode + "\\([0-9-]+\\)\s+" ; Date + "\\([0-9:]+\\)\s+" ; Time + "\\(.*\\)\n" ; Name )) (goto-char (match-end 0)) (let ((name (match-string 6)) @@ -2091,7 +2056,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." ;; The code below assumes the name is relative and may do undesirable ;; things otherwise. (error "Can't extract files with non-relative names") - (archive-extract-by-file archive name `("unar" "-no-directory" "-o") "Successfully extracted"))) + (archive-extract-by-file archive name '("unar" "-no-directory" "-o") "Successfully extracted"))) ;;; Section: Rar self-extracting .exe archives. @@ -2212,8 +2177,6 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (while (looking-at archive-ar-file-header-re) (let ((name (match-string 1)) extname - ;; Emacs will automatically use float here because those - ;; timestamps don't fit in our ints. (time (string-to-number (match-string 2))) (user (match-string 3)) (group (match-string 4)) |