Mercurial > emacs

changeset 29424:5fe4cd1c83ba

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(tar-header-block-recompute-checksum): Remove. (tar-clip-time-string): Prepend a space. (tar-grind-file-mode): Construct a string rather than modifying one. (tar-header-block-summarize): Fix docstring. Use `format' rather than an error-prone set of copy-loops.
author Stefan Monnier <monnier@iro.umontreal.ca>
date Mon, 05 Jun 2000 07:44:59 +0000
parents 12e89e9b65f6
children 846240c6fd38
files lisp/tar-mode.el
diffstat 1 files changed, 39 insertions(+), 87 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/tar-mode.el	Mon Jun 05 07:30:09 2000 +0000
+++ b/lisp/tar-mode.el	Mon Jun 05 07:44:59 2000 +0000
@@ -314,38 +314,26 @@
   (if (not (= desired-checksum (tar-header-block-checksum hblock)))
       (progn (beep) (message "Invalid checksum for file %s!" file-name))))
 
-(defun tar-header-block-recompute-checksum (hblock)
-  "Modifies the given string to have a valid checksum field."
-  (let* ((chk (tar-header-block-checksum hblock))
-	 (chk-string (format "%6o" chk))
-	 (l (length chk-string)))
-    (aset hblock 154 0)
-    (aset hblock 155 32)
-    (dotimes (i l) (aset hblock (- 153 i) (aref chk-string (- l i 1)))))
-  hblock)
-
 (defun tar-clip-time-string (time)
   (let ((str (current-time-string time)))
-    (concat (substring str 4 16) (substring str 19 24))))
+    (concat " " (substring str 4 16) (substring str 19 24))))
 
-(defun tar-grind-file-mode (mode string start)
-  "Store `-rw--r--r--' indicating MODE into STRING beginning at START.
+(defun tar-grind-file-mode (mode)
+  "Construct a `-rw--r--r--' string indicating MODE.
 MODE should be an integer which is a file mode value."
-  (aset string start       (if (zerop (logand 256 mode)) ?- ?r))
-  (aset string (+ start 1) (if (zerop (logand 128 mode)) ?- ?w))
-  (aset string (+ start 2) (if (zerop (logand  64 mode)) ?- ?x)) 
-  (aset string (+ start 3) (if (zerop (logand  32 mode)) ?- ?r))
-  (aset string (+ start 4) (if (zerop (logand  16 mode)) ?- ?w))
-  (aset string (+ start 5) (if (zerop (logand   8 mode)) ?- ?x))
-  (aset string (+ start 6) (if (zerop (logand   4 mode)) ?- ?r))
-  (aset string (+ start 7) (if (zerop (logand   2 mode)) ?- ?w))
-  (aset string (+ start 8) (if (zerop (logand   1 mode)) ?- ?x))
-  (if (zerop (logand 1024 mode)) nil (aset string (+ start 2) ?s))
-  (if (zerop (logand 2048 mode)) nil (aset string (+ start 5) ?s))
-  string)
+  (string
+   (if (zerop (logand 256 mode)) ?- ?r)
+   (if (zerop (logand 128 mode)) ?- ?w)
+   (if (zerop (logand 1024 mode)) (if (zerop (logand  64 mode)) ?- ?x) ?s)
+   (if (zerop (logand  32 mode)) ?- ?r)
+   (if (zerop (logand  16 mode)) ?- ?w)
+   (if (zerop (logand 2048 mode)) (if (zerop (logand   8 mode)) ?- ?x) ?s)
+   (if (zerop (logand   4 mode)) ?- ?r)
+   (if (zerop (logand   2 mode)) ?- ?w)
+   (if (zerop (logand   1 mode)) ?- ?x)))
 
 (defun tar-header-block-summarize (tar-hblock &optional mod-p)
-  "Returns a line similar to the output of `tar -vtf'."
+  "Return a line similar to the output of `tar -vtf'."
   (let ((name (tar-header-name tar-hblock))
 	(mode (tar-header-mode tar-hblock))
 	(uid (tar-header-uid tar-hblock))
@@ -355,68 +343,32 @@
 	(size (tar-header-size tar-hblock))
 	(time (tar-header-date tar-hblock))
 	(ck (tar-header-checksum tar-hblock))
-	(link-p (tar-header-link-type tar-hblock))
-	(link-name (tar-header-link-name tar-hblock))
-	)
-    (let* ((left 11)
-	   (namew 8)
-	   (groupw 8)
-	   (sizew 8)
-	   (datew (if tar-mode-show-date 18 0))
-	   (slash (1- (+ left namew)))
-	   (lastdigit (+ slash groupw sizew))
-	   (datestart (+ lastdigit 2))
-	   (namestart (+ datestart datew))
-	   (multibyte (or (multibyte-string-p name)
-			  (multibyte-string-p link-name)))
-	   ;; If multibyte, we can't use optimized method of aset,
-	   ;; instead we must use concat.
-	   (string (make-string (if multibyte
-				    namestart
-				  (+ namestart
-				     (length name)
-				     (if link-p (+ 5 (length link-name)) 0)))
-				32))
-	   (type (tar-header-link-type tar-hblock)))
-      (aset string 0 (if mod-p ?* ? ))
-      (aset string 1
+	(type (tar-header-link-type tar-hblock))
+	(link-name (tar-header-link-name tar-hblock)))
+    (format "%c%c%s%8s/%-8s%7s%s %s%s"
+	    (if mod-p ?* ? )
 	    (cond ((or (eq type nil) (eq type 0)) ?-)
-		  ((eq type 1) ?l)  ; link
-		  ((eq type 2) ?s)  ; symlink
-		  ((eq type 3) ?c)  ; char special
-		  ((eq type 4) ?b)  ; block special
-		  ((eq type 5) ?d)  ; directory
-		  ((eq type 6) ?p)  ; FIFO/pipe
-		  ((eq type 20) ?*) ; directory listing
-		  ((eq type 29) ?M) ; multivolume continuation
-		  ((eq type 35) ?S) ; sparse
-		  ((eq type 38) ?V) ; volume header
-		  ))
-      (tar-grind-file-mode mode string 2)
-      (setq uid (if (= 0 (length uname)) (int-to-string uid) uname))
-      (setq gid (if (= 0 (length gname)) (int-to-string gid) gname))
-      (setq size (int-to-string size))
-      (setq time (tar-clip-time-string time))
-      (dotimes (i (min (1- namew) (length uid))) (aset string (- slash i) (aref uid (- (length uid) i 1))))
-      (aset string (1+ slash) ?/)
-      (dotimes (i (min (1- groupw) (length gid))) (aset string (+ (+ slash 2) i) (aref gid i)))
-      (dotimes (i (min sizew (length size))) (aset string (- lastdigit i) (aref size (- (length size) i 1))))
-      (if tar-mode-show-date
-	  (dotimes (i (length time)) (aset string (+ datestart i) (aref time i))))
-      (if multibyte
-	  (setq string (concat string name))
-	(dotimes (i (length name)) (aset string (+ namestart i) (aref name i))))
-      (if (or (eq link-p 1) (eq link-p 2))
-	  (if multibyte
-	      (setq string (concat string
-				   (if (= link-p 1) " ==> " " --> ")
-				   link-name))
-	    (dotimes (i 3) (aset string (+ namestart 1 (length name) i) (aref (if (= link-p 1) "==>" "-->") i)))
-	    (dotimes (i (length link-name)) (aset string (+ namestart 5 (length name) i) (aref link-name i)))))
-      (put-text-property namestart (length string)
-			 'mouse-face 'highlight string)
-      string)))
-
+		  ((eq type 1) ?l)	; link
+		  ((eq type 2) ?s)	; symlink
+		  ((eq type 3) ?c)	; char special
+		  ((eq type 4) ?b)	; block special
+		  ((eq type 5) ?d)	; directory
+		  ((eq type 6) ?p)	; FIFO/pipe
+		  ((eq type 20) ?*)	; directory listing
+		  ((eq type 29) ?M)	; multivolume continuation
+		  ((eq type 35) ?S)	; sparse
+		  ((eq type 38) ?V)	; volume header
+		  (t ?\ )
+		  )
+	    (tar-grind-file-mode mode)
+	    (if (= 0 (length uname)) uid uname)
+	    (if (= 0 (length gname)) gid gname)
+	    size
+	    (if tar-mode-show-date (tar-clip-time-string time) "")
+	    (propertize name 'mouse-face 'highlight)
+	    (if (or (eq type 1) (eq type 2))
+		(concat (if (= type 1) " ==> " " --> ") link-name)
+	      ""))))
 
 (defun tar-summarize-buffer ()
   "Parse the contents of the tar file in the current buffer.