mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-22 10:26:20 +00:00
Code Issues Releases Activity

(archive-unixdate): Corrected the date field string.

Browse Source 
(archive-lzh-summarize): Extended it to allow the LZH level 2 header
type (which is most prevalent now), in addition to the already
supported level 0 and 1 header types.
This commit is contained in:
Richard M. Stallman 2003-01-25 19:34:15 +00:00
parent 418af85949
commit 5f23d8367c
1 changed files with 90 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

139
lisp/arc-mode.el
View File

@ -77,6 +77,12 @@
;;
;; LZH A series of (header,file). Headers are checksummed. No
;; interaction among members.
;; Headers come in three flavours called level 0, 1 and 2 headers.
;; Level 2 header is free of DOS specific restrictions and most
;; prevalently used. Also level 1 and 2 headers consist of base
;; and extension headers. For more details see
;; http://homepage1.nifty.com/dangan/en/Content/Program/Java/jLHA/Notes/Notes.html
;; http://www.osirusoft.com/joejared/lzhformat.html
;;
;; ZIP A series of (lheader,fil) followed by a "central directory"
;; which is a series of (cheader) followed by an end-of-
@ -463,18 +469,18 @@ the mode is invalid. If ERROR is nil then nil will be returned."
(second (* 2 (logand time 31)))) ; 2 seconds resolution
(format "%02d:%02d:%02d" hour minute second)))
;;(defun archive-unixdate (low high)
;; "Stringify unix (LOW HIGH) date."
;; (let ((str (current-time-string (cons high low))))
;; (format "%s-%s-%s"
;; (substring str 8 9)
;; (substring str 4 7)
;; (substring str 20 24))))
(defun archive-unixdate (low high)
"Stringify unix (LOW HIGH) date."
(let ((str (current-time-string (cons high low))))
(format "%s-%s-%s"
(substring str 8 10)
(substring str 4 7)
(substring str 20 24))))
;;(defun archive-unixtime (low high)
;; "Stringify unix (LOW HIGH) time."
;; (let ((str (current-time-string (cons high low))))
;; (substring str 11 19)))
(defun archive-unixtime (low high)
"Stringify unix (LOW HIGH) time."
(let ((str (current-time-string (cons high low))))
(substring str 11 19)))
(defun archive-get-lineno ()
(if (>= (point) archive-file-list-start)
@ -1408,38 +1414,48 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(maxlen 8)
files
visual)
(while (progn (goto-char p)
(while (progn (goto-char p) ;beginning of a base header.
(looking-at "\\(.\\|\n\\)\\(.\\|\n\\)-l[hz][0-9ds]-"))
(let* ((hsize (char-after p))
(csize (archive-l-e (+ p 7) 4))
(ucsize (archive-l-e (+ p 11) 4))
(modtime (archive-l-e (+ p 15) 2))
(moddate (archive-l-e (+ p 17) 2))
(hdrlvl (char-after (+ p 20)))
(fnlen (char-after (+ p 21)))
(efnname (let ((str (buffer-substring (+ p 22) (+ p 22 fnlen))))
(let* ((hsize (char-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.
(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 (char-after (+ p 20))) ;header level
thsize ;total header size (base + extensions)
fnlen efnname fiddle ifnname width p2 creator
neh ;beginning of next extension header (level 1 and 2)
mode modestr uid gid text dir prname
gname uname modtime moddate)
(if (= hdrlvl 3) (error "can't handle lzh level 3 header type"))
(when (or (= hdrlvl 0) (= hdrlvl 1))
(setq fnlen (char-after (+ p 21))) ;filename length
(setq efnname (let ((str (buffer-substring (+ p 22) (+ p 22 fnlen)))) ;filename from offset 22
(if file-name-coding-system
(decode-coding-string str file-name-coding-system)
(string-as-multibyte str))))
(fiddle (string= efnname (upcase efnname)))
(ifnname (if fiddle (downcase efnname) efnname))
(width (string-width ifnname))
(p2 (+ p 22 fnlen))
(creator (if (>= (- hsize fnlen) 24) (char-after (+ p2 2)) 0))
mode modestr uid gid text dir prname
)
(if (= hdrlvl 0)
(setq mode (if (= creator ?U) (archive-l-e (+ p2 8) 2) ?\666)
uid (if (= creator ?U) (archive-l-e (+ p2 10) 2))
gid (if (= creator ?U) (archive-l-e (+ p2 12) 2)))
(if (= creator ?U)
(let* ((p3 (+ p2 3))
(hsize (archive-l-e p3 2))
(etype (char-after (+ p3 2))))
(while (not (= hsize 0))
(setq p2 (+ p 22 fnlen))) ;
(if (= hdrlvl 1)
(progn ;specific to level 1 header
(setq creator (if (>= (- hsize fnlen) 24) (char-after (+ p2 2)) 0))
(setq neh (+ p2 3)))
(if (= hdrlvl 2)
(progn ;specific to level 2 header
(setq creator (char-after (+ p 23)) )
(setq neh (+ p 24)))))
(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 (char-after (+ neh 2)))) ;extension type
(while (not (= ehsize 0))
(cond
((= etype 2) (let ((i (+ p3 3)))
(while (< i (+ p3 hsize))
((= etype 1) ;file name
(let ((i (+ neh 3)))
(while (< i (+ neh ehsize))
(setq efnname (concat efnname (char-to-string (char-after i))))
(setq i (1+ i)))))
((= etype 2) ;directory name
(let ((i (+ neh 3)))
(while (< i (+ neh ehsize))
(setq dir (concat dir
(if (= (char-after i)
255)
@ -1447,15 +1463,40 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(char-to-string
(char-after i)))))
(setq i (1+ i)))))
((= etype 80) (setq mode (archive-l-e (+ p3 3) 2)))
((= etype 81) (progn (setq uid (archive-l-e (+ p3 3) 2))
(setq gid (archive-l-e (+ p3 5) 2))))
((= etype 80) ;Unix file permission
(setq mode (archive-l-e (+ neh 3) 2)))
((= etype 81) ;UNIX file group/user ID
(progn (setq uid (archive-l-e (+ neh 3) 2))
(setq gid (archive-l-e (+ neh 5) 2))))
((= etype 82) ;UNIX file group name
(let ((i (+ neh 3)))
(while (< i (+ neh ehsize))
(setq gname (concat gname (char-to-string (char-after i))))
(setq i (1+ i)))))
((= etype 83) ;UNIX file user name
(let ((i (+ neh 3)))
(while (< i (+ neh ehsize))
(setq uname (concat uname (char-to-string (char-after i))))
(setq i (1+ i)))))
)
(setq p3 (+ p3 hsize))
(setq hsize (archive-l-e p3 2))
(setq etype (char-after (+ p3 2)))))))
(setq neh (+ neh ehsize))
(setq ehsize (archive-l-e neh 2))
(setq etype (char-after (+ neh 2))))
;;get total header size for level 1 and 2 headers
(setq thsize (- neh p))))
(if (= hdrlvl 0) ;total header size
(setq thsize hsize))
(setq fiddle (string= efnname (upcase efnname)))
(setq ifnname (if fiddle (downcase efnname) efnname))
(setq prname (if dir (concat dir ifnname) ifnname))
(setq width (string-width prname))
(setq modestr (if mode (archive-int-to-mode mode) "??????????"))
(setq moddate (if (= hdrlvl 2)
(archive-unixdate time1 time2) ;level 2 header in UNIX format
(archive-dosdate time2))) ;level 0 and 1 header in DOS format
(setq modtime (if (= hdrlvl 2)
(archive-unixtime time1 time2)
(archive-dostime time1)))
(setq text (if archive-alternate-display
(format " %8d %5S %5S %s"
ucsize
@ -1465,18 +1506,18 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(format " %10s %8d %-11s %-8s %s"
modestr
ucsize
(archive-dosdate moddate)
(archive-dostime modtime)
ifnname)))
moddate
modtime
prname)))
(setq maxlen (max maxlen width)
totalsize (+ totalsize ucsize)
visual (cons (vector text
(- (length text) (length ifnname))
(- (length text) (length prname))
(length text))
visual)
files (cons (vector prname ifnname fiddle mode (1- p))
files)
p (+ p hsize 2 csize))))
p (+ p thsize 2 csize))))
(goto-char (point-min))
(set-buffer-multibyte default-enable-multibyte-characters)
(let ((dash (concat (if archive-alternate-display