Subject: bug#19274: closed (Re: bug#19274: tar-mode.el: allow for adding new archive members )

From: [email-masked] (GNU bug Tracking System)
Date: Tue, 27 Jan 2015 22:05:02 +0000

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 [email-masked].

-- 
19274: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=19274
GNU Bug Tracking System
Contact [email-masked] with problems

Subject: Re: bug#19274: tar-mode.el: allow for adding new archive members
From: Ivan Shmakov <[email-masked]>
To: [email-masked]
Date: Tue, 27 Jan 2015 22:04:18 +0000
List-Id: <debbugs-submit.debbugs.gnu.org>

Version: 25.1

>>>>> Ivan Shmakov <[email-masked]> writes:

[…]

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

 > [1] news:[email-masked]
 >     http://permalink.gmane.org/gmane.emacs.bugs/96948

	Pushed; closing.

-- 
FSF associate member #7257  http://boycottsystemd.org/  … 3013 B6A0 230E 334A
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

Subject: tar-mode.el: allow for adding new archive members
From: Ivan Shmakov <[email-masked]>
To: [email-masked]
Date: Thu, 04 Dec 2014 21:17:54 +0000
List-Id: <debbugs-submit.debbugs.gnu.org>

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
--- 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."