GNU bug report logs - #19274
tar-mode.el: allow for adding new archive members

Previous Next

Full log

View this message in rfc822 format

From: help-debbugs <at> gnu.org (GNU bug Tracking System)
To: Ivan Shmakov <ivan <at> siamics.net>
Subject: bug#19274: closed (Re: bug#19274: tar-mode.el: allow for adding
 new archive members )
Date: Tue, 27 Jan 2015 22:05:02 +0000

[Message part 1 (text/plain, inline)]

Your bug report

#19274: tar-mode.el: allow for adding new archive members 

which was filed against the emacs package, has been closed.

The explanation is attached below, along with your original report.
If you require more details, please reply to 19274 <at> debbugs.gnu.org.

-- 
19274: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=19274
GNU Bug Tracking System
Contact help-debbugs <at> gnu.org with problems

[Message part 2 (message/rfc822, inline)]

From: Ivan Shmakov <ivan <at> siamics.net>
To: 19274-done <at> debbugs.gnu.org
Subject: Re: bug#19274: tar-mode.el: allow for adding new archive members 
Date: Tue, 27 Jan 2015 22:04:18 +0000

[Message part 3 (text/plain, inline)]

Version: 25.1

>>>>> Ivan Shmakov <ivan <at> siamics.net> writes:

[…]

 > The revised patch for doc/emacs/files.texi is MIMEd.  (The rest
 > remains the same [1].)

 > [1] news:871tobl5cd.fsf <at> violet.siamics.net
 >     http://permalink.gmane.org/gmane.emacs.bugs/96948

	Pushed; closing.

-- 
FSF associate member #7257  http://boycottsystemd.org/  … 3013 B6A0 230E 334A

[Message part 4 (text/plain, inline)]

commit a56eab8259568ea1389e972623e46359e73c0233

    Allow for adding new members to Tar archives.

    * lisp/tar-mode.el: Allow for adding new archive members.
    (tar-new-regular-file-header, tar--pad-to, tar--put-at)
    (tar-header-serialize): New functions.
    (tar-current-position): Split from tar-current-descriptor.
    (tar-current-descriptor): Use it.
    (tar-new-entry): New command.
    (tar-mode-map): Bind it.
    * doc/emacs/files.texi (File Archives): Document "I" for tar-new-entry.
    * etc/NEWS: Mention the new tar-new-entry command.

    Fixes: debbugs:19274

[Message part 5 (message/rfc822, inline)]

From: Ivan Shmakov <ivan <at> siamics.net>
To: submit <at> debbugs.gnu.org
Subject: tar-mode.el: allow for adding new archive members 
Date: Thu, 04 Dec 2014 21:17:54 +0000

[Message part 6 (text/plain, inline)]

Package:  emacs
Severity: wishlist

	Please consider the patch MIMEd.

	* tar-mode.el: Allow for adding new archive members.
	(tar--pad-to, tar--put-at, tar-header-serialize): New functions.
	(tar-current-position): Split from tar-current-descriptor.
	(tar-current-descriptor): Use it.
	(tar-new-entry): New command.
	(tar-mode-map): Bind it.

-- 
FSF associate member #7257  http://boycottsystemd.org/  … 3013 B6A0 230E 334A

[Message part 7 (text/diff, inline)]

--- a/lisp/tar-mode.el
+++ b/lisp/tar-mode.el
@@ -369,6 +369,58 @@
 	string)
   (tar-parse-octal-integer string))
 
+(defun tar--pad-to (pos)
+  (make-string (+ pos (- (point)) (point-min)) 0))
+
+(defun tar--put-at (pos val)
+  (when val
+    (insert (tar--pad-to pos) val)))
+
+(defun tar-header-serialize (header &optional update-checksum)
+  (with-temp-buffer
+    (set-buffer-multibyte nil)
+    (let ((encoded-name
+	   (encode-coding-string (tar-header-name header)
+				 tar-file-name-coding-system)))
+      (unless (< (length encoded-name) 99)
+	;; FIXME: implement it
+	(error "Long file name support is not implemented"))
+      (insert encoded-name))
+    (insert (tar--pad-to tar-mode-offset)
+	    (format "%6o\0 " (logand #o777777 (tar-header-mode header)))
+	    (format "%6o\0 " (logand #o777777 (tar-header-uid  header)))
+	    (format "%6o\0 " (logand #o777777 (tar-header-gid  header))))
+    (insert (tar--pad-to tar-size-offset)
+	    (format "%11o " (tar-header-size header)))
+    (insert (tar--pad-to tar-time-offset)
+	    (tar-octal-time (tar-header-date header))
+	    " ")
+    ;; omit tar-header-checksum (tar-chk-offset) for now
+    (tar--put-at   tar-linkp-offset (tar-header-link-type header))
+    (tar--put-at   tar-link-offset  (tar-header-link-name header))
+    (when (tar-header-magic header)
+      (tar--put-at tar-magic-offset (tar-header-magic header))
+      (tar--put-at tar-uname-offset (tar-header-uname header))
+      (tar--put-at tar-gname-offset (tar-header-gname header))
+      (let ((dmaj (tar-header-dmaj header))
+	    (dmin (tar-header-dmin header)))
+	(tar--put-at tar-dmaj-offset
+		     (and dmaj (format "%7o\0" (logand #o7777777 dmaj))))
+	(tar--put-at tar-dmin-offset
+		     (and dmin (format "%7o\0" (logand #o7777777 dmin))))))
+    (tar--put-at 512 "")
+    (let ((ck (tar-header-block-checksum (buffer-string))))
+      (goto-char (+ (point-min) tar-chk-offset))
+      (delete-char 8)
+      (insert (format "%6o\0 " ck))
+      (when update-checksum
+	(setf (tar-header-checksum header) ck))
+      (tar-header-block-check-checksum (buffer-string)
+				       (tar-header-checksum header)
+				       (tar-header-name header)))
+    ;; .
+    (buffer-string)))
+
 
 (defun tar-header-block-checksum (string)
   "Compute and return a tar-acceptable checksum for this block."
@@ -547,6 +599,7 @@ defvar tar-mode-map
     (define-key map "p" 'tar-previous-line)
     (define-key map "\^P" 'tar-previous-line)
     (define-key map [up] 'tar-previous-line)
+    (define-key map "I" 'tar-new-entry)
     (define-key map "R" 'tar-rename-entry)
     (define-key map "u" 'tar-unflag)
     (define-key map "v" 'tar-view)
@@ -731,10 +784,14 @@
   (interactive "p")
   (tar-next-line (- arg)))
 
+(defun tar-current-position ()
+  "Return the `tar-parse-info' index for the current line."
+  (count-lines (point-min) (line-beginning-position)))
+
 (defun tar-current-descriptor (&optional noerror)
   "Return the tar-descriptor of the current line, or signals an error."
   ;; I wish lines had plists, like in ZMACS...
-  (or (nth (count-lines (point-min) (line-beginning-position))
+  (or (nth (tar-current-position)
 	   tar-parse-info)
       (if noerror
 	  nil
@@ -948,6 +1005,45 @@
 	(write-region start end to-file nil nil nil t)))
     (message "Copied tar entry %s to %s" name to-file)))
 
+(defun tar-new-entry (filename &optional index)
+  "Insert a new empty regular file before point."
+  (interactive "*sNew file name: ")
+  (let* ((buffer  (current-buffer))
+	 (index   (or index (tar-current-position)))
+	 (d-list  (and (not (zerop index))
+		       (nthcdr (+ -1 index) tar-parse-info)))
+	 (pos     (if d-list
+		      (tar-header-data-end (car d-list))
+		    (point-min)))
+	 (new-descriptor
+	  (make-tar-header
+	   nil
+	   filename
+	   #o644 0 0 0
+	   (current-time)
+	   nil				; checksum
+	   nil nil
+	   nil nil nil nil nil)))
+    ;; update the data buffer; fill the missing descriptor fields
+    (with-current-buffer tar-data-buffer
+      (goto-char pos)
+      (insert (tar-header-serialize new-descriptor t))
+      (setf  (tar-header-data-start new-descriptor)
+	     (copy-marker (point) nil)))
+    ;; update tar-parse-info
+    (if d-list
+	(setcdr d-list     (cons new-descriptor (cdr d-list)))
+      (setq tar-parse-info (cons new-descriptor
+				 tar-parse-info)))
+    ;; update the listing buffer
+    (save-excursion
+      (goto-char (point-min))
+      (forward-line index)
+      (let ((inhibit-read-only t))
+	(insert (tar-header-block-summarize new-descriptor) ?\n)))
+    ;; .
+    index))
+
 (defun tar-flag-deleted (p &optional unflag)
   "In Tar mode, mark this sub-file to be deleted from the tar file.
 With a prefix argument, mark that many files."

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.