From: Ivan Shmakov Date: Tue, 27 Jan 2015 21:25:56 +0000 (+0000) Subject: Allow for adding new members to Tar archives. X-Git-Tag: emacs-25.0.90~2572^2~59 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=a56eab8259568ea1389e972623e46359e73c0233;p=emacs.git 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 --- diff --git a/doc/emacs/ChangeLog b/doc/emacs/ChangeLog index a90c58725f8..b7853a7f118 100644 --- a/doc/emacs/ChangeLog +++ b/doc/emacs/ChangeLog @@ -1,3 +1,8 @@ +2015-01-27 Ivan Shmakov + + * files.texi (File Archives): Document "I" for tar-new-entry. + (Bug#19274) + 2014-12-31 Paul Eggert Less 'make' chatter for Emacs doc diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index 196c6bb0092..b12b28f9c17 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -1689,6 +1689,13 @@ likewise. @kbd{v} extracts a file into a buffer in View mode 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 before 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. diff --git a/etc/ChangeLog b/etc/ChangeLog index b31e8a99383..0677e441b83 100644 --- a/etc/ChangeLog +++ b/etc/ChangeLog @@ -1,3 +1,7 @@ +2015-01-27 Ivan Shmakov + + * NEWS: Mention the new tar-new-entry command. (Bug#19274) + 2015-01-27 Thomas Fitzsimmons * NEWS: Document EUDC improvements. diff --git a/etc/NEWS b/etc/NEWS index 755277854b7..4b0a268d8f2 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -527,6 +527,10 @@ to avoid interfering with the kill ring. allow overriding the regular expression that recognizes the ldapsearch command line's password prompt. ++++ +** tar-mode: new `tar-new-entry' command, allowing for new members to +be added to the archive. + ** Obsolete packages --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 80dfeef3750..182d7705bb6 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,13 @@ +2015-01-27 Ivan Shmakov + + * tar-mode.el: Allow for adding new archive members. (Bug#19274) + (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. + 2015-01-27 Sam Steingold * progmodes/python.el (python-check-custom-command): Buffer local diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el index 1ee54515bea..6c7f7553f82 100644 --- a/lisp/tar-mode.el +++ b/lisp/tar-mode.el @@ -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 @@ write-date, checksum, link-type, and link-name." 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 @@ MODE should be an integer which is a file mode value." (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 @@ tar-file's buffer." (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 @@ the current tar-entry." (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."