Mercurial > emacs

changeset 49437:3a18e49975cb

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(archive-unixdate): Corrected the date field string. (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.
author Richard M. Stallman <rms@gnu.org>
date Sat, 25 Jan 2003 19:34:15 +0000
parents 0055338cb706
children 389e078f2b48
files lisp/arc-mode.el
diffstat 1 files changed, 90 insertions(+), 49 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/arc-mode.el	Sat Jan 25 18:26:37 2003 +0000
+++ b/lisp/arc-mode.el	Sat Jan 25 19:34:15 2003 +0000
@@ -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 @@
         (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 @@
 	(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 @@
 							 (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 @@
 			(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