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

[Ivan Shmakov]

>>>>> Eli Zaretskii <eliz@gnu.org> writes:
>>>>> From: Ivan Shmakov  Date: Sat, 06 Dec 2014 20:50:36 +0000

 >>> fgrep -w Tar doc/emacs/*.texi

 >> Now, it makes me wonder if there should be an @findex tar-mode along
 >> with the @cindices?  (And @findex archive-mode, too.)

 > What, just to help us search for it?  These functions are never
 > mentioned in that node.

 > But I don't mind adding the index entries.

        I guess my idea of a better Emacs manual includes documenting
        all the command names alongside their respective default
        bindings.  Looks like it warrants a separate bug report, though.

 > (In general, the best way of doing this search is to take note of the
 > node you are reading in Info, and then search for the corresponding
 > @node line.)

        In this particular case, I should have tried the command below.

$ grep -irE --include=\*.texi -- '\<tar\>' doc/ 

[…]

 >> The command inserts the new file on the line above the current one,
 >> so that using it on the topmost line of the Tar buffer makes the new
 >> file the first one in the archive, and using it on the last line
 >> (the one after the line describing the last file) makes it the last
 >> one.

 > Instead of the complicated description of "the last line, which is
 > one line after the last file's line", I'd simply say "at the end of
 > the buffer".  This is simpler and much more clear, especially to
 > non-native speakers who might have problems with long and complex
 > sentences.

        Indeed, that’s much better.  Does it make sense to also simplify
        the head of the sentence as follows?  (I believe that “lines”
        are rather just an implementation detail here.)

- The command inserts the new file on the line above the current one,
+ The command inserts the new file before the current one,

 > Otherwise, it's fine.  Thanks.  (Don't forget to mark the NEWS entry
 > with "+++" together with installing this change.)

        Meanwhile, I’ve also simplified tar-header-serialize a bit (at
        the cost of adding a couple of lines to tar--put-at) – and
        hopefully made it more readable at the same time.

        The (once again) revised patch is MIMEd.

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

--- a/etc/NEWS  2014-11-27 11:36:08 +0000
+++ b/etc/NEWS  2014-12-07 17:31:11 +0000
@@ -340,6 +340,10 @@
 `tildify-ignored-environments-alist' variables (as well as a few
 helper functions) obsolete.
 
++++
+** tar-mode: new `tar-new-entry' command, allowing for new members to
+be added to the archive.
+
 ** Obsolete packages
 
 ---
--- a/doc/emacs/files.texi      2014-06-08 07:41:27 +0000
+++ b/doc/emacs/files.texi      2014-12-07 17:35:34 +0000
@@ -1689,6 +1689,13 @@ @node File Archives
 another window, so you could edit the file and operate on the archive
 simultaneously.
 
+  The @kbd{I} key adds a new (regular) file to the archive.  The file
+is initially empty, but can readily be edited using the commands
+above.  The command inserts the new file on the line above the current
+one, so that using it on the topmost line of the Tar buffer makes the
+new file the first one in the archive, and using it at the end of the
+buffer makes it the last one.
+
   @kbd{d} marks a file for deletion when you later use @kbd{x}, and
 @kbd{u} unmarks a file, as in Dired.  @kbd{C} copies a file from the
 archive to disk and @kbd{R} renames a file within the archive.
--- a/lisp/tar-mode.el  2014-08-28 19:18:24 +0000
+++ b/lisp/tar-mode.el  2014-12-07 17:44:40 +0000
@@ -50,9 +50,6 @@
 ;;
 ;; o  chmod should understand "a+x,og-w".
 ;;
-;; o  It's not possible to add a NEW file to a tar archive; not that
-;;    important, but still...
-;;
 ;; o  The code is less efficient that it could be - in a lot of places, I
 ;;    pull a 512-character string out of the buffer and parse it, when I could
 ;;    be parsing it in place, not garbaging a string.  Should redo that.
@@ -369,6 +366,80 @@
        string)
   (tar-parse-octal-integer string))
 
+(defun tar-new-regular-file-header (filename &optional size time)
+  "Return a Tar header for a regular file.
+The header will lack a proper checksum; use `tar-header-block-checksum'
+to compute one, or request `tar-header-serialize' to do that.
+
+Other tar-mode facilities may also require the data-start header
+field to be set to a valid value.
+
+If SIZE is not given or nil, it defaults to 0.
+If TIME is not given or nil, assume now."
+  (make-tar-header
+   nil
+   filename
+   #o644 0 0 (or size 0)
+   (or time (current-time))
+   nil                         ; checksum
+   nil nil
+   nil nil nil nil nil))
+
+(defun tar--pad-to (pos)
+  (make-string (+ pos (- (point)) (point-min)) 0))
+
+(defun tar--put-at (pos val &optional fmt mask)
+  (when val
+    (insert (tar--pad-to pos)
+           (if fmt
+               (format fmt (if mask (logand mask val) val))
+             val))))
+
+(defun tar-header-serialize (header &optional update-checksum)
+  "Return the serialization of a Tar HEADER as a string.
+This function calls `tar-header-block-check-checksum' to ensure the
+checksum is correct.
+
+If UPDATE-CHECKSUM is non-nil, update HEADER with the newly-computed
+checksum before doing the check."
+  (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))
+    (tar--put-at tar-mode-offset (tar-header-mode header) "%6o\0 " #o777777)
+    (tar--put-at tar-uid-offset  (tar-header-uid  header) "%6o\0 " #o777777)
+    (tar--put-at tar-gid-offset  (tar-header-gid  header) "%6o\0 " #o777777)
+    (tar--put-at tar-size-offset (tar-header-size header) "%11o ")
+    (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))
+      (tar--put-at tar-dmaj-offset (tar-header-dmaj header) "%7o\0" #o7777777)
+      (tar--put-at tar-dmin-offset (tar-header-dmin header) "%7o\0" #o7777777))
+    (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 +618,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 +803,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 +1024,37 @@
        (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 "*sFile 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
+         (tar-new-regular-file-header filename)))
+    ;; 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."