;;; tar-mode.el --- simple editing of tar files from GNU emacs;; Copyright (C) 1990-1993, 1997 Free Software Foundation, Inc.;; Author: Jamie Zawinski <jwz@jwz.org>;; Keywords: unix;; Created: 4 Apr 1990;; Version: 1.32;; This file is part of XEmacs.;; XEmacs is free software; you can redistribute it and/or modify it;; under the terms of the GNU General Public License as published by;; the Free Software Foundation; either version 2, or (at your option);; any later version.;; XEmacs is distributed in the hope that it will be useful, but;; WITHOUT ANY WARRANTY; without even the implied warranty of;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU;; General Public License for more details.;; You should have received a copy of the GNU General Public License;; along with XEmacs; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,;; Boston, MA 02111-1307, USA.;;; Synched up with: partially synched with Emacs 20.;;; Commentary:;; This package attempts to make dealing with Unix 'tar' archives easier.;; When this code is loaded, visiting a file whose name ends in '.tar' will;; cause the contents of that archive file to be displayed in a Dired-like;; listing. It is then possible to use the customary Dired keybindings to;; extract sub-files from that archive, either by reading them into their own;; editor buffers, or by copying them directly to arbitrary files on disk.;; It is also possible to delete sub-files from within the tar file and write;; the modified archive back to disk, or to edit sub-files within the archive;; and re-insert the modified files into the archive. See the documentation;; string of tar-mode for more info.;; To autoload, add this to your .emacs file:;;;; (setq auto-mode-alist (cons '("\\.tar$" . tar-mode) auto-mode-alist));; (autoload 'tar-mode "tar-mode");;;; But beware: for certain tar files - those whose very first file has ;; a -*- property line - autoloading won't work. See the function ;; "tar-normal-mode" to understand why.;; This code now understands the extra fields that GNU tar adds to tar files.;; This interacts correctly with "uncompress.el" in the Emacs library,;; and with sufficiently recent versions of "crypt.el" by Kyle Jones.;; *************** TO DO *************** ;;;; 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.;;;; o I'd like a command that searches for a string/regexp in every subfile;; of an archive, where <esc> would leave you in a subfile-edit buffer.;; (Like M-s in VM and M-r in the Zmacs mail reader.);;;; o Sometimes (but not always) reverting the tar-file buffer does not ;; re-grind the listing, and you are staring at the binary tar data.;; Typing 'g' again immediately after that will always revert and re-grind;; it, though. I have no idea why this happens.;;;; o Tar-mode interacts poorly with crypt.el and zcat.el because the tar;; write-file-hook actually writes the file. Instead it should remove the;; header (and conspire to put it back afterwards) so that other write-file;; hooks which frob the buffer have a chance to do their dirty work. There;; might be a problem if the tar write-file-hook does not come *first* on;; the list.;;;; o Block files, sparse files, continuation files, and the various header;; types aren't editable. Actually I don't know that they work at all.;; If you know that they work, or know that they don't, please let me know.;;;; o Tar files inside of tar files don't work.;;;; o When using crypt-mode, you can't save a compressed or encrypted subfile;; of a tar file back into the tar file: it is saved uncompressed.;;; Code:(defgrouptar()"Simple editing of tar files from GNU emacs.":group'unix:group'data)(defcustomtar-anal-blocksize20"*The blocksize of tar files written by Emacs, or nil, meaning don't care.The blocksize of a tar file is not really the size of the blocks; rather, it isthe number of blocks written with one system call. When tarring to a tape, this is the size of the *tape* blocks, but when writing to a file, it doesn'tmatter much. The only noticeable difference is that if a tar file does nothave a blocksize of 20, the tar program will issue a warning; all this reallycontrols is how many null padding bytes go on the end of the tar file.":type'integer:group'tar)(defcustomtar-update-datestampt"*Whether tar-mode should play fast and loose with sub-file datestamps;if this is true, then editing and saving a tar file entry back into itstar file will update its datestamp. If false, the datestamp is unchanged.You may or may not want this - it is good in that you can tell when a filein a tar archive has been changed, but it is bad for the same reason thatediting a file in the tar archive at all is bad - the changed version of the file never exists on disk.This does not work in Emacs 18, because there's no way to get the current time as an integer - if this var is true, then editing a file sets its dateto midnight, Jan 1 1970 GMT, which happens to be what 0 encodes.":type'boolean:group'tar);;; First, duplicate some Common Lisp functions; I used to just (require 'cl);;; but "cl.el" was messing some people up (also it's really big).;; No need for that stuff anymore -- XEmacs preloads cl.el anyway.;;; down to business.(defmacrotar-make-header(namemodeuidgitsizedateckltlnmagicunamegnamedevmajdevmin)(list'vectornamemodeuidgitsizedateckltlnmagicunamegnamedevmajdevmin))(defmacrotar-header-name(x)(list'arefx0))(defmacrotar-header-mode(x)(list'arefx1))(defmacrotar-header-uid(x)(list'arefx2))(defmacrotar-header-gid(x)(list'arefx3))(defmacrotar-header-size(x)(list'arefx4))(defmacrotar-header-date(x)(list'arefx5))(defmacrotar-header-checksum(x)(list'arefx6))(defmacrotar-header-link-type(x)(list'arefx7))(defmacrotar-header-link-name(x)(list'arefx8))(defmacrotar-header-magic(x)(list'arefx9))(defmacrotar-header-uname(x)(list'arefx10))(defmacrotar-header-gname(x)(list'arefx11))(defmacrotar-header-dmaj(x)(list'arefx12))(defmacrotar-header-dmin(x)(list'arefx13))(defmacrotar-make-desc(data-starttokens)(list'consdata-starttokens))(defmacrotar-desc-data-start(x)(list'carx))(defmacrotar-desc-tokens(x)(list'cdrx))(defconsttar-name-offset0)(defconsttar-mode-offset(+tar-name-offset100))(defconsttar-uid-offset(+tar-mode-offset8))(defconsttar-gid-offset(+tar-uid-offset8))(defconsttar-size-offset(+tar-gid-offset8))(defconsttar-time-offset(+tar-size-offset12))(defconsttar-chk-offset(+tar-time-offset12))(defconsttar-linkp-offset(+tar-chk-offset8))(defconsttar-link-offset(+tar-linkp-offset1));;; GNU-tar specific slots.(defconsttar-magic-offset(+tar-link-offset100))(defconsttar-uname-offset(+tar-magic-offset8))(defconsttar-gname-offset(+tar-uname-offset32))(defconsttar-dmaj-offset(+tar-gname-offset32))(defconsttar-dmin-offset(+tar-dmaj-offset8))(defconsttar-end-offset(+tar-dmin-offset8))(defuntar-tokenize-header-block(string)"Return a `tar-header' structure.This is a list of name, mode, uid, gid, size, write-date, checksum, link-type, and link-name."(cond((<(lengthstring)512)nil)(;(some 'plusp string) ; <-- oops, massive cycle hog!(or(not(=0(arefstring0))); This will do.(not(=0(arefstring101))))(let*((name-end(1-tar-mode-offset))(link-end(1-tar-magic-offset))(uname-end(1-tar-gname-offset))(gname-end(1-tar-dmaj-offset))(link-p(arefstringtar-linkp-offset))(magic-str(substringstringtar-magic-offset(1-tar-uname-offset)))(uname-valid-p(or(string="ustar "magic-str)(string="GNUtar "magic-str)))name(nulsexp"[^\000]*\000"))(and(string-matchnulsexpstringtar-name-offset)(setqname-end(minname-end(1-(match-end0)))))(and(string-matchnulsexpstringtar-link-offset)(setqlink-end(minlink-end(1-(match-end0)))))(and(string-matchnulsexpstringtar-uname-offset)(setquname-end(minuname-end(1-(match-end0)))))(and(string-matchnulsexpstringtar-gname-offset)(setqgname-end(mingname-end(1-(match-end0)))))(setqname(substringstringtar-name-offsetname-end)link-p(if(or(=link-p0)(=link-p?0))nil(-link-p?0)))(if(and(nulllink-p)(string-match"/$"name))(setqlink-p5)); directory(tar-make-headername(tar-parse-octal-integerstringtar-mode-offset(1-tar-uid-offset))(tar-parse-octal-integerstringtar-uid-offset(1-tar-gid-offset))(tar-parse-octal-integerstringtar-gid-offset(1-tar-size-offset))(tar-parse-octal-integerstringtar-size-offset(1-tar-time-offset))(tar-parse-octal-integer-32stringtar-time-offset(1-tar-chk-offset))(tar-parse-octal-integerstringtar-chk-offset(1-tar-linkp-offset))link-p(substringstringtar-link-offsetlink-end)uname-valid-p(anduname-valid-p(substringstringtar-uname-offsetuname-end))(anduname-valid-p(substringstringtar-gname-offsetgname-end))(tar-parse-octal-integerstringtar-dmaj-offset(1-tar-dmin-offset))(tar-parse-octal-integerstringtar-dmin-offset(1-tar-end-offset)))))(t'empty-tar-block)))(defuntar-parse-octal-integer(string&optionalstartend)(if(nullstart)(setqstart0))(if(nullend)(setqend(lengthstring)))(if(=(arefstringstart)0)0(let((n0))(while(<startend)(setqn(if(<(arefstringstart)?0)n(+(*n8)(-(arefstringstart)48)))start(1+start)))n)))(defuntar-parse-octal-integer-32(string&optionalstartend);; like tar-parse-octal-integer, but returns a cons of two 16-bit numbers,;; since elisp can't handle integers of that magnitude.(orstart(setqstart0))(orend(setqend(lengthstring)))(let((top(tar-parse-octal-integerstringstart(-end6)))(bot(tar-parse-octal-integerstring(-end6)end)))(setqtop(logior(ashtop2)(ashbot-16)))(setqbot(logandbot65535))(constopbot)))(defuntar-parse-octal-integer-safe(string)(let((L(lengthstring)))(if(=L0)(error"empty string"))(dotimes(iL)(if(or(<(arefstringi)?0)(>(arefstringi)?7))(error"'%c' is not an octal digit."))))(tar-parse-octal-integerstring))(defuntar-header-block-checksum(string)"Compute and return a tar-acceptable checksum for this block."(let*((chk-field-starttar-chk-offset)(chk-field-end(+chk-field-start8))(sum0)(i0));; Add up all of the characters except the ones in the checksum field.;; Add that field as if it were filled with spaces.(while(<ichk-field-start)(setqsum(+sum(arefstringi))i(1+i)))(setqichk-field-end)(while(<i512)(setqsum(+sum(arefstringi))i(1+i)))(+sum(*328))))(defuntar-header-block-check-checksum(hblockdesired-checksumfile-name)"Beep and print a warning if the checksum doesn't match."(if(not(=desired-checksum(tar-header-block-checksumhblock)))(progn(beep)(message"Invalid checksum for file %s!"file-name))))(defuntar-header-block-recompute-checksum(hblock)"Modifies the given string to have a valid checksum field."(let*((chk(tar-header-block-checksumhblock))(chk-string(format"%6o"chk))(l(lengthchk-string)))(asethblock1540)(asethblock15532)(dotimes(il)(asethblock(-153i)(arefchk-string(-li1)))))hblock)(defuntar-grind-file-mode(modestringstart)"Store `-rw--r--r--' indicating MODE into STRING beginning at START.MODE should be an integer which is a file mode value."(asetstringstart(if(zerop(logand256mode))?-?r))(asetstring(+start1)(if(zerop(logand128mode))?-?w))(asetstring(+start2)(if(zerop(logand64mode))?-?x))(asetstring(+start3)(if(zerop(logand32mode))?-?r))(asetstring(+start4)(if(zerop(logand16mode))?-?w))(asetstring(+start5)(if(zerop(logand8mode))?-?x))(asetstring(+start6)(if(zerop(logand4mode))?-?r))(asetstring(+start7)(if(zerop(logand2mode))?-?w))(asetstring(+start8)(if(zerop(logand1mode))?-?x))(if(zerop(logand1024mode))nil(asetstring(+start2)?s))(if(zerop(logand2048mode))nil(asetstring(+start5)?s))string)(defconsttar-can-print-dates(or(fboundp'current-time)(fboundp'current-time-seconds))"true if this emacs has been built with time-printing support")(defuntar-summarize-header-block(tar-hblock&optionalmod-p)"Returns a line similar to the output of `tar -vtf'."(let((name(tar-header-nametar-hblock))(mode(tar-header-modetar-hblock))(uid(tar-header-uidtar-hblock))(gid(tar-header-gidtar-hblock))(uname(tar-header-unametar-hblock))(gname(tar-header-gnametar-hblock))(size(tar-header-sizetar-hblock))(time(tar-header-datetar-hblock))(ck(tar-header-checksumtar-hblock))(link-p(tar-header-link-typetar-hblock))(link-name(tar-header-link-nametar-hblock)))(let*((left11)(namew8)(groupw8)(sizew8)(datew(iftar-can-print-dates152))(slash(1-(+leftnamew)))(lastdigit(+slashgroupwsizew))(namestart(+lastdigitdatew))(string(make-string(+namestart(lengthname)(iflink-p(+5(lengthlink-name))0))32))(type(tar-header-link-typetar-hblock)))(asetstring0(ifmod-p?*?))(asetstring1(cond((or(eqtypenil)(eqtype0))?-)((eqtype1)?l); link((eqtype2)?s); symlink((eqtype3)?c); char special((eqtype4)?b); block special((eqtype5)?d); directory((eqtype6)?p); FIFO/pipe((eqtype20)?*); directory listing((eqtype29)?M); multivolume continuation((eqtype35)?S); sparse((eqtype38)?V); volume header))(tar-grind-file-modemodestring2)(setquid(if(=0(lengthuname))(int-to-stringuid)uname))(setqgid(if(=0(lengthgname))(int-to-stringgid)gname))(setqsize(int-to-stringsize))(dotimes(i(min(1-namew)(lengthuid)))(asetstring(-slashi)(arefuid(-(lengthuid)i1))))(asetstring(1+slash)?/)(dotimes(i(min(1-groupw)(lengthgid)))(asetstring(+(+slash2)i)(arefgidi)))(dotimes(i(minsizew(lengthsize)))(asetstring(-lastdigiti)(arefsize(-(lengthsize)i1))))(iftar-can-print-dates(let*((year(substring(current-time-string)-4));; in v18, current-time-string doesn't take an argument(file(current-time-stringtime))(file-year(substringfile-4))(str(if(equalyearfile-year)(substringfile416)(concat(substringfile411)" "file-year))))(dotimes(i12)(asetstring(-namestart(-13i))(arefstri)))))(dotimes(i(lengthname))(asetstring(+namestarti)(arefnamei)))(if(or(eqlink-p1)(eqlink-p2))(progn(dotimes(i3)(asetstring(+namestart1(lengthname)i)(aref(if(=link-p1)"==>""-->")i)))(dotimes(i(lengthlink-name))(asetstring(+namestart5(lengthname)i)(areflink-namei)))))string)));; buffer-local variables in the tar file's buffer:;;(defvartar-parse-info); the header structures(defvartar-header-offset); the end of the "pretty" data(defuntar-summarize-buffer()"Parse the contents of the tar file in the current buffer, and place adired-like listing on the front; then narrow to it, so that only that listingis visible (and the real data of the buffer is hidden)."(message"parsing tar file...")(let*((result'())(pos1)(bs(max1(-(buffer-size)1024))); always 2+ empty blocks at end.(bs100(max1(/bs100)))(tokensnil))(while(not(eqtokens'empty-tar-block))(if(>(+pos512)(point-max))(error"truncated tar file"))(let*((hblock(buffer-substringpos(+pos512))))(setqtokens(tar-tokenize-header-blockhblock))(setqpos(+pos512))(message"parsing tar file...%s%%";(/ (* pos 100) bs) ; this gets round-off lossage(/posbs100); this doesn't)(if(eqtokens'empty-tar-block)nil(if(nulltokens)(error"premature EOF parsing tar file."))(if(eq(tar-header-link-typetokens)20);; Foo. There's an extra empty block after these.(setqpos(+pos512)))(let((size(tar-header-sizetokens)))(if(<size0)(error"%s has size %s - corrupted."(tar-header-nametokens)size));; This is just too slow. Don't really need it anyway....;(tar-check-header-block-checksum; hblock (tar-checksum-header-block hblock); (tar-header-name tokens))(setqresult(cons(tar-make-descpostokens)result))(if(and(null(tar-header-link-typetokens))(>size0))(setqpos(+pos512(ash(ash(1-size)-9)9)); this works;(+ pos (+ size (- 512 (rem (1- size) 512)))) ; this doesn't))))))(make-local-variable'tar-parse-info)(setqtar-parse-info(nreverseresult)))(message"parsing tar file...formatting...")(save-excursion(goto-char(point-min))(let((buffer-read-onlynil))(dolist(tar-desctar-parse-info)(insert(tar-summarize-header-block(tar-desc-tokenstar-desc))"\n"))(make-local-variable'tar-header-offset)(setqtar-header-offset(point))(narrow-to-region1tar-header-offset)(set-buffer-modified-pnil)))(message"parsing tar file...done."))(defvartar-mode-mapnil"*Local keymap for tar-mode listings.")(iftar-mode-mapnil(setqtar-mode-map(make-keymap))(suppress-keymaptar-mode-map);; Commands to mark certain categories of files;; Upper case keys for operating on the marked files(define-keytar-mode-map"C"'tar-copy)(define-keytar-mode-map"R"'tar-rename-entry)(define-keytar-mode-map"M"'tar-chmod-entry)(define-keytar-mode-map"G"'tar-chgrp-entry)(define-keytar-mode-map"O"'tar-chown-entry);; Lower keys for commands not operating on all the marked files(define-keytar-mode-map"d"'tar-flag-deleted)(define-keytar-mode-map"\^D"'tar-flag-deleted)(define-keytar-mode-map"e"'tar-extract)(define-keytar-mode-map"f"'tar-extract)(define-keytar-mode-map[return]'tar-extract)(define-keytar-mode-map"g"'revert-buffer)(define-keytar-mode-map"h"'describe-mode)(define-keytar-mode-map"o"'tar-extract-other-window)(define-keytar-mode-map"q"'tar-quit)(define-keytar-mode-map"u"'tar-unflag)(define-keytar-mode-map"v"'tar-view)(define-keytar-mode-map"x"'tar-expunge)(define-keytar-mode-map'backspace'tar-unflag-backwards)(define-keytar-mode-map'delete'tar-unflag-backwards)(define-keytar-mode-map"E"'tar-extract-other-window);; moving(define-keytar-mode-map" "'tar-next-line)(define-keytar-mode-map"n"'tar-next-line)(define-keytar-mode-map"\^N"'tar-next-line)(define-keytar-mode-map[down]'tar-next-line)(define-keytar-mode-map"p"'tar-previous-line)(define-keytar-mode-map"\^P"'tar-previous-line)(define-keytar-mode-map[up]'tar-previous-line)(cond((and(featurep'xemacs)(not(featurep'infodock)))(define-keytar-mode-map'button2'tar-track-mouse-and-extract-file)(define-keytar-mode-map'button3'tar-popup-menu))));; XEmacs menu mouse/support added by Heiko Muenkel;; muenkel@tnt.uni-hannover.de(autoload'dired-mark-region"dired-xemacs-menu")(defvartar-menu'("Tar Mode Commands"["Copy Subfile to Disk"tar-copyt]["Rename Subfile"tar-rename-entryt]"----"["Delete Flaged Subfiles"tar-expunget]["Flag Subfile for Deletion"tar-flag-deletedt]["Flag Subfiles in Region for Deletion"(dired-mark-region'(tar-flag-deleted1))(mark)]["Unflag Subfile"tar-unflagt]["Unflag Subfiles in Region"(dired-mark-region'(tar-flag-deleted1t))(mark)]"----"["Change Permissions of Subfile..."tar-chmod-entryt]["Change Group of Subfile..."tar-chgrp-entryt]["Change Owner of Subfile..."tar-chown-entryt]"----"["Edit Subfile Other Window"tar-extract-other-windowt]["Edit Subfile"tar-extractt]["View Subfile"tar-viewt]"----"["Quit Tar Mode"tar-quitt]))(defuntar-track-mouse-and-extract-file(event)"Visit the tar-file-entry upon which the mouse is clicked."(interactive"e")(mouse-set-pointevent)(tar-next-line0)(let(buffer)(save-excursion(tar-extract)(setqbuffer(current-buffer)))(switch-to-bufferbuffer)))(defuntar-popup-menu(event)"Display the tar-mode menu."(interactive"@e")(mouse-set-pointevent)(tar-next-line0)(popup-menutar-menu));; tar mode is suitable only for specially formatted data.(put'tar-mode'mode-class'special)(put'tar-subfile-mode'mode-class'special);;;###autoload(defuntar-mode()"Major mode for viewing a tar file as a dired-like listing of its contents.You can move around using the usual cursor motion commands. Letters no longer insert themselves.Type `e' to pull a file out of the tar file and into its own buffer;or click mouse-2 on the file's line in the Tar mode buffer.Type `c' to copy an entry from the tar file into another file on disk.If you edit a sub-file of this archive (as with the `e' command) and save it with Control-x Control-s, the contents of that buffer will be saved back into the tar-file buffer; in this way you can edit a file inside of a tar archive without extracting it and re-archiving it.See also: variables `tar-update-datestamp' and `tar-anal-blocksize'.\\{tar-mode-map}";; this is not interactive because you shouldn't be turning this;; mode on and off. You can corrupt things that way.(make-local-variable'tar-header-offset)(make-local-variable'tar-parse-info)(make-local-variable'require-final-newline)(setqrequire-final-newlinenil); binary data, dude...(make-local-variable'revert-buffer-function)(setqrevert-buffer-function'tar-mode-revert)(setqmajor-mode'tar-mode)(setqmode-name"Tar")(use-local-maptar-mode-map)(auto-save-mode0)(widen)(if(and(boundp'tar-header-offset)tar-header-offset)(narrow-to-region1tar-header-offset)(tar-summarize-buffer))(cond((string-match"XEmacs"emacs-version)(require'mode-motion)(setqmode-motion-hook'mode-motion-highlight-line)(when(and(boundp'current-menubar)current-menubar(not(assoc"Tar"current-menubar)))(set-buffer-menubar(copy-sequencecurrent-menubar))(add-menunil"Tar"(cdrtar-menu)))))(run-hooks'tar-mode-hook));; buffer-local variables in subfile mode.;;(defvartar-subfile-modenil); whether the minor-mode is on(defvartar-superior-buffer); parent buffer(defvartar-superior-descriptor); header object of this file(defvartar-subfile-buffer-id); pretty name-string(defvarsubfile-orig-mlbid); orig mode-line-buffer-identification(defuntar-subfile-mode(p)"Minor mode for editing an element of a tar-file.This mode arranges for \"saving\" this buffer to write the datainto the tar-file buffer that it came from. The changes will actuallyappear on disk when you save the tar-file's buffer."(interactive"P")(or(and(boundp'tar-superior-buffer)tar-superior-buffer)(error"This buffer is not an element of a tar file."))(or(assq'tar-subfile-modeminor-mode-alist)(setqminor-mode-alist(appendminor-mode-alist(list'(tar-subfile-mode" TarFile")))))(make-local-variable'tar-subfile-mode)(setqtar-subfile-mode(if(nullp)(nottar-subfile-mode)(>(prefix-numeric-valuep)0)))(cond(tar-subfile-mode;; copy the local keymap so that we don't accidentally;; alter a keymap like 'lisp-mode-map' which is shared;; by all buffers in that mode.(let((m(current-local-map)))(ifm(use-local-map(copy-keymapm))))(local-set-key"\^X\^S"'tar-subfile-save-buffer);; turn off auto-save.(setqbuffer-auto-save-file-namenil)(auto-save-mode0)(run-hooks'tar-subfile-mode-hook))(t;; remove the local binding for C-x C-s.(local-unset-key"\^X\^S")(ifsubfile-orig-mlbid(set(make-local-variable'mode-line-buffer-identification)subfile-orig-mlbid))(setqtar-superior-bufferniltar-superior-descriptornilsubfile-orig-mlbidnil))))(defuntar-subfile-after-write-file-hook();; if the buffer has a filename, then it is no longer associated with;; the tar file. Turn off subfile mode.(if(andbuffer-file-nametar-subfile-mode)(tar-subfile-mode-1)))(defuntar-mode-revert(&optionalno-autosaveno-confirm)"Revert this buffer and turn on tar mode again, to re-compute thedirectory listing."(setqtar-header-offsetnil)(let((revert-buffer-functionnil))(revert-buffertno-confirm)(widen))(tar-mode))(defuntar-next-line(p)(interactive"p")(forward-linep)(if(eobp)nil(forward-char(iftar-can-print-dates4836))))(defuntar-previous-line(p)(interactive"p")(tar-next-line(-p)))(defuntar-current-descriptor(&optionalnoerror)"Returns 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)(save-excursion(beginning-of-line)(point)))tar-parse-info)(ifnoerrornil(error"This line does not describe a tar-file entry."))))(defuntar-extract(&optionalother-window-p)"In tar-mode, extract this entry of the tar file into its own buffer."(interactive)(let*((view-p(eqother-window-p'view))(descriptor(tar-current-descriptor))(tokens(tar-desc-tokensdescriptor))(name(tar-header-nametokens))(size(tar-header-sizetokens))(link-p(tar-header-link-typetokens))(start(+(tar-desc-data-startdescriptor)tar-header-offset-1))(end(+startsize)))(iflink-p(error"This is a %s, not a real file."(cond((eqlink-p5)"directory")((eqlink-p20)"tar directory header")((eqlink-p29)"multivolume-continuation")((eqlink-p35)"sparse entry")((eqlink-p38)"volume header")(t"link"))))(if(zeropsize)(error"This is a zero-length file."))(let*((tar-buffer(current-buffer))(bufname(file-name-nondirectoryname))(bufid(concat;" (" name " in "" (in "(file-name-nondirectory(buffer-file-name))")"))(read-only-p(orbuffer-read-onlyview-p))(buffernil)(buffers(buffer-list))(just-creatednil));; find a buffer visiting this subfile from this tar file.(while(andbuffers(notbuffer))(set-buffer(carbuffers))(if(and(null(buffer-file-name(carbuffers)))(boundp'tar-superior-descriptor)(eqtar-superior-descriptordescriptor))(setqbuffer(carbuffers))(setqbuffers(cdrbuffers))))(set-buffertar-buffer)(ifbuffernil(setqbuffer(generate-new-bufferbufname))(setqjust-createdt)(unwind-protect(progn(widen)(save-excursion(set-bufferbuffer)(insert-buffer-substringtar-bufferstartend)(goto-char0)(let((lock-directorynil)); disable locking(set-visited-file-namename); give it a name to decide mode.;; (normal-mode) ; pick a mode.;; (after-find-file nil nil) ; pick a mode; works with crypt.el;; Ok, instead of running after-find-file, just invoke the;; find-file-hooks instead. This does everything we want;; from after-find-file, without losing when visiting .tar;; files via ange-ftp: doesn't probe the ftp site for the;; name of the subfile.(normal-modet)(run-hooks'find-file-hooks)(set-visited-file-namenil); nuke the name - not meaningful.)(make-local-variable'tar-superior-buffer)(make-local-variable'tar-superior-descriptor)(make-local-variable'mode-line-buffer-identification)(make-local-variable'tar-subfile-buffer-id)(make-local-variable'subfile-orig-mlbid)(setqtar-superior-buffertar-buffer)(setqtar-superior-descriptordescriptor)(setqtar-subfile-buffer-idbufid)(setqsubfile-orig-mlbidmode-line-buffer-identification)(cond((stringpmode-line-buffer-identification)(setqmode-line-buffer-identification(listmode-line-buffer-identification))))(let((ms(carmode-line-buffer-identification))n)(cond((and(stringpms)(string-match"%\\([0-9]+\\)b\\'"ms))(setqmode-line-buffer-identification(cons(concat(substringms0(1-(match-beginning1)))(substringms(1+(match-end1))))(cons(list(car(read-from-string(substringms(match-beginning1)(match-end1))))(concat"%b"tar-subfile-buffer-id))(cdrmode-line-buffer-identification)))))(t(setqmode-line-buffer-identification(list"Emacs: "(list17(concat"%b"tar-subfile-buffer-id)))))))(tar-subfile-mode1)(setqbuffer-read-onlyread-only-p)(set-buffer-modified-pnil))(set-buffertar-buffer))(narrow-to-region1tar-header-offset)))(ifview-p(progn(view-buffer-other-windowbuffer)(save-excursion(set-bufferbuffer);; for view-less.el; view.el can't do this.(set(make-local-variable'view-kill-on-exit)t)))(ifother-window-p(switch-to-buffer-other-windowbuffer)(switch-to-bufferbuffer))))))(defuntar-extract-other-window()"In tar-mode, extract this entry of the tar file into its own buffer."(interactive)(tar-extractt))(defuntar-view()"In tar-mode, view the tar file entry on this line."(interactive)(tar-extract'view))(defuntar-read-file-name(&optionalprompt)"Read a file name with this line's entry as the default."(orprompt(setqprompt"Copy to: "))(let*((default-file(expand-file-name(tar-header-name(tar-desc-tokens(tar-current-descriptor)))))(target(expand-file-name(read-file-nameprompt(file-name-directorydefault-file)default-filenil))))(if(or(string=""(file-name-nondirectorytarget))(file-directory-ptarget))(setqtarget(concat(if(string-match"/$"target)(substringtarget0(1-(match-end0)))target)"/"(file-name-nondirectorydefault-file))))target))(defuntar-copy(&optionalto-file)"In tar-mode, extract this entry of the tar file into a file on disk.If TO-FILE is not supplied, it is prompted for, defaulting to the name ofthe current tar-entry."(interactive(list(tar-read-file-name)))(let*((descriptor(tar-current-descriptor))(tokens(tar-desc-tokensdescriptor))(name(tar-header-nametokens))(size(tar-header-sizetokens))(link-p(tar-header-link-typetokens))(start(+(tar-desc-data-startdescriptor)tar-header-offset-1))(end(+startsize)))(iflink-p(error"This is a link, not a real file."))(if(zeropsize)(error"This is a zero-length file."))(let*((tar-buffer(current-buffer))buffer)(unwind-protect(progn(setqbuffer(generate-new-buffer"*tar-copy-tmp*"))(widen)(save-excursion(set-bufferbuffer)(insert-buffer-substringtar-bufferstartend)(set-buffer-modified-pnil); in case we abort(write-fileto-file)(message"Copied tar entry %s to %s"nameto-file)(set-buffertar-buffer)))(narrow-to-region1tar-header-offset)(ifbuffer(kill-bufferbuffer))))))(defuntar-flag-deleted(p&optionalunflag)"In tar-mode, mark this sub-file to be deleted from the tar file.With a prefix argument, mark that many files."(interactive"p")(beginning-of-line)(dotimes(i(if(<p0)(-p)p))(if(tar-current-descriptorunflag); barf if we're not on an entry-line.(progn(delete-char1)(insert(ifunflag" ""D"))))(forward-line(if(<p0)-11)))(if(eobp)nil(forward-char36)))(defuntar-unflag(p)"In tar-mode, un-mark this sub-file if it is marked to be deleted.With a prefix argument, un-mark that many files forward."(interactive"p")(tar-flag-deletedpt))(defuntar-unflag-backwards(p)"In tar-mode, un-mark this sub-file if it is marked to be deleted.With a prefix argument, un-mark that many files backward."(interactive"p")(tar-flag-deleted(-p)t))(defuntar-expunge-internal()"Expunge the tar-entry specified by the current line."(let*((descriptor(tar-current-descriptor))(tokens(tar-desc-tokensdescriptor))(line(tar-desc-data-startdescriptor))(name(tar-header-nametokens))(size(tar-header-sizetokens))(link-p(tar-header-link-typetokens))(start(tar-desc-data-startdescriptor))(following-descs(cdr(memqdescriptortar-parse-info))))(iflink-p(setqsize0)); size lies for hard-links.;;;; delete the current line...(beginning-of-line)(let((line-start(point)))(end-of-line)(forward-char)(let((line-len(-(point)line-start)))(delete-regionline-start(point));;;; decrement the header-pointer to be in synch...(setqtar-header-offset(-tar-header-offsetline-len))));;;; delete the data pointer...(setqtar-parse-info(delqdescriptortar-parse-info));;;; delete the data from inside the file...(widen)(let*((data-start(+starttar-header-offset-513))(data-end(+data-start512(ash(ash(+size511)-9)9))))(delete-regiondata-startdata-end);;;; and finally, decrement the start-pointers of all following;; entries in the archive. This is a pig when deleting a bunch;; of files at once - we could optimize this to only do the;; iteration over the files that remain, or only iterate up to;; the next file to be deleted.(let((data-length(-data-enddata-start)))(dolist(descfollowing-descs)(setf(tar-desc-data-startdesc)(-(tar-desc-data-startdesc)data-length))))))(narrow-to-region1tar-header-offset))(defuntar-expunge(&optionalnoconfirm)"In tar-mode, delete all the archived files flagged for deletion.This does not modify the disk image; you must save the tar file itselffor this to be permanent."(interactive)(if(ornoconfirm(y-or-n-p"Expunge files marked for deletion? "))(let((n0))(save-excursion(goto-char0)(while(not(eobp))(if(looking-at"D")(progn(tar-expunge-internal)(setqn(1+n)))(forward-line1)));; after doing the deletions, add any padding that may be necessary.(tar-pad-to-blocksize)(narrow-to-region1tar-header-offset))(if(zeropn)(message"Nothing to expunge.")(message"%s files expunged. Be sure to save this buffer."n)))))(defuntar-clear-modification-flags()"Remove the stars at the beginning of each line."(interactive)(save-excursion(goto-char0)(while(<(point)tar-header-offset)(if(looking-at"*")(progn(delete-char1)(insert" ")))(forward-line1))))(defuntar-chown-entry(new-uid)"Change the user-id associated with this entry in the tar file.If this tar file was written by GNU tar, then you will be able to editthe user id as a string; otherwise, you must edit it as a number.You can force editing as a number by calling this with a prefix arg.This does not modify the disk image; you must save the tar file itselffor this to be permanent."(interactive(list(let((tokens(tar-desc-tokens(tar-current-descriptor))))(if(orcurrent-prefix-arg(not(tar-header-magictokens)))(let(n)(while(not(numberp(setqn(read-minibuffer"New UID number: "(format"%s"(tar-header-uidtokens)))))))n)(read-string"New UID string: "(tar-header-unametokens))))))(cond((stringpnew-uid)(setf(tar-header-uname(tar-desc-tokens(tar-current-descriptor)))new-uid)(tar-alter-one-fieldtar-uname-offset(concatnew-uid"\000")))(t(setf(tar-header-uid(tar-desc-tokens(tar-current-descriptor)))new-uid)(tar-alter-one-fieldtar-uid-offset(concat(substring(format"%6o"new-uid)06)"\000 ")))))(defuntar-chgrp-entry(new-gid)"Change the group-id associated with this entry in the tar file.If this tar file was written by GNU tar, then you will be able to editthe group id as a string; otherwise, you must edit it as a number.You can force editing as a number by calling this with a prefix arg.This does not modify the disk image; you must save the tar file itselffor this to be permanent."(interactive(list(let((tokens(tar-desc-tokens(tar-current-descriptor))))(if(orcurrent-prefix-arg(not(tar-header-magictokens)))(let(n)(while(not(numberp(setqn(read-minibuffer"New GID number: "(format"%s"(tar-header-gidtokens)))))))n)(read-string"New GID string: "(tar-header-gnametokens))))))(cond((stringpnew-gid)(setf(tar-header-gname(tar-desc-tokens(tar-current-descriptor)))new-gid)(tar-alter-one-fieldtar-gname-offset(concatnew-gid"\000")))(t(setf(tar-header-gid(tar-desc-tokens(tar-current-descriptor)))new-gid)(tar-alter-one-fieldtar-gid-offset(concat(substring(format"%6o"new-gid)06)"\000 ")))))(defuntar-rename-entry(new-name)"Change the name associated with this entry in the tar file.This does not modify the disk image; you must save the tar file itselffor this to be permanent."(interactive(list(read-string"New name: "(tar-header-name(tar-desc-tokens(tar-current-descriptor))))))(if(string=""new-name)(error"zero length name"))(if(>(lengthnew-name)98)(error"name too long"))(setf(tar-header-name(tar-desc-tokens(tar-current-descriptor)))new-name)(tar-alter-one-field0(substring(concatnew-name(make-string990))099)))(defuntar-chmod-entry(new-mode)"Change the protection bits associated with this entry in the tar file.This does not modify the disk image; you must save the tar file itselffor this to be permanent."(interactive(list(tar-parse-octal-integer-safe(read-string"New protection (octal): "))))(setf(tar-header-mode(tar-desc-tokens(tar-current-descriptor)))new-mode)(tar-alter-one-fieldtar-mode-offset(concat(substring(format"%6o"new-mode)06)"\000 ")))(defuntar-alter-one-field(data-positionnew-data-string)(let*((descriptor(tar-current-descriptor))(tokens(tar-desc-tokensdescriptor)))(unwind-protect(save-excursion;;;; update the header-line.(beginning-of-line)(let((p(point)))(forward-line1)(delete-regionp(point))(insert(tar-summarize-header-blocktokens)"\n")(setqtar-header-offset(point-max)))(widen)(let*((start(+(tar-desc-data-startdescriptor)tar-header-offset-513)));;;; delete the old field and insert a new one.(goto-char(+startdata-position))(delete-region(point)(+(point)(lengthnew-data-string))); <--(insertnew-data-string); <--;;;; compute a new checksum and insert it.(let((chk(tar-header-block-checksum(buffer-substringstart(+start512)))))(goto-char(+starttar-chk-offset))(delete-region(point)(+(point)8))(insert(format"%6o"chk))(insert0)(insert?)(setf(tar-header-checksumtokens)chk);;;; ok, make sure we didn't botch it.(tar-header-block-check-checksum(buffer-substringstart(+start512))chk(tar-header-nametokens)))))(narrow-to-region1tar-header-offset))))(defuntar-subfile-save-buffer()"In tar subfile mode, save this buffer into its parent tar-file buffer.This doesn't write anything to disk; you must save the parent tar-file bufferto make your changes permanent."(interactive)(cond(buffer-file-name;; tar-subfile buffers should have nil as buffer-file-name. If they;; ever gain a buffer-file-name, that means they have been written to;; a real disk file, as with ^X^W. If this happens, behave just like;; `save-buffer.'(call-interactively'save-buffer))(t(tar-subfile-save-buffer-internal))))(defuntar-subfile-save-buffer-internal()(if(not(and(boundp'tar-superior-buffer)tar-superior-buffer))(error"This buffer has no superior tar file buffer."))(or(buffer-nametar-superior-buffer)(error"The superior tar file's buffer has been killed."))(if(not(and(boundp'tar-superior-descriptor)tar-superior-descriptor))(error"This buffer doesn't have an index into its superior tar file!"));; Notice when crypt.el has uncompressed while reading the subfile, and;; signal an error if the user tries to save back into the parent file;; (because it won't work - the .Z subfile it writes won't really be;; compressed.);;; ;; These are for the old crypt.el; (if (and (boundp 'buffer-save-encrypted) buffer-save-encrypted); (error "Don't know how to encrypt back into a tar file.")); (if (and (boundp 'buffer-save-compacted) buffer-save-compacted); (error "Don't know how to compact back into a tar file.")); (if (and (boundp 'buffer-save-compressed) buffer-save-compressed); (error "Don't know how to compress back into a tar file.")); (if (and (boundp 'buffer-save-gzipped) buffer-save-gzipped); (error "Don't know how to gzip back into a tar file."));; These are for the new crypt++.el(if(and(boundp'crypt-buffer-save-encrypted)crypt-buffer-save-encrypted)(error"Don't know how to encrypt back into a tar file."))(if(and(boundp'crypt-buffer-save-compact)crypt-buffer-save-compact)(error"Don't know how to compact back into a tar file."))(if(and(boundp'crypt-buffer-save-compress)crypt-buffer-save-compress)(error"Don't know how to compress back into a tar file."))(if(and(boundp'crypt-buffer-save-gzip)crypt-buffer-save-gzip)(error"Don't know how to gzip back into a tar file."))(if(and(boundp'crypt-buffer-save-freeze)crypt-buffer-save-freeze)(error"Don't know how to freeze back into a tar file."))(save-excursion(let((subfile(current-buffer))(subfile-size(buffer-size))(descriptortar-superior-descriptor))(set-buffertar-superior-buffer)(let*((tokens(tar-desc-tokensdescriptor))(start(tar-desc-data-startdescriptor))(name(tar-header-nametokens))(size(tar-header-sizetokens))(size-pad(ash(ash(+size511)-9)9))(head(memqdescriptortar-parse-info))(following-descs(cdrhead)))(if(nothead)(error"Can't find this tar file entry in its parent tar file!"))(unwind-protect(save-excursion(widen);; delete the old data...(let*((data-start(+starttar-header-offset-1))(data-end(+data-start(ash(ash(+size511)-9)9))))(delete-regiondata-startdata-end);; insert the new data...(goto-chardata-start)(insert-buffersubfile);;;; pad the new data out to a multiple of 512...(let((subfile-size-pad(ash(ash(+subfile-size511)-9)9)))(goto-char(+data-startsubfile-size))(insert(make-string(-subfile-size-padsubfile-size)0));;;; update the data pointer of this and all following files...(setf(tar-header-sizetokens)subfile-size)(let((difference(-subfile-size-padsize-pad)))(dolist(descfollowing-descs)(setf(tar-desc-data-startdesc)(+(tar-desc-data-startdesc)difference))));;;; Update the size field in the header block.(let((header-start(-data-start512)))(goto-char(+header-starttar-size-offset))(delete-region(point)(+(point)12))(insert(format"%11o"subfile-size))(insert?);;;; Maybe update the datestamp.(if(nottar-update-datestamp)nil(goto-char(+header-starttar-time-offset))(delete-region(point)(+(point)12))(let(nowtopbot)(cond((fboundp'current-time)(setqnow(current-time))(setcdrnow(car(cdrnow)))); ((fboundp 'current-time-seconds); (setq now (current-time-seconds))))(setqtop(carnow)bot(cdrnow))(cond(now(setf(tar-header-datetokens)now);; hair to print two 16-bit numbers as one octal number.(setqbot(logior(ash(logandtop3)16)bot))(setqtop(ashtop-2))(insert(format"%5o"top))(insert(format"%06o "bot)))(t;; otherwise, set it to the epoch.(insert(format"%11o "0))(setf(tar-header-datetokens)(cons00))))));;;; compute a new checksum and insert it.(let((chk(tar-header-block-checksum(buffer-substringheader-startdata-start))))(goto-char(+header-starttar-chk-offset))(delete-region(point)(+(point)8))(insert(format"%6o"chk))(insert0)(insert?)(setf(tar-header-checksumtokens)chk)));;;; alter the descriptor-line...;;(let((position(-(lengthtar-parse-info)(lengthhead))))(goto-char1)(next-lineposition)(beginning-of-line)(let((p(point))(m(set-marker(make-marker)tar-header-offset)))(forward-line1)(delete-regionp(point))(insert-before-markers(tar-summarize-header-blocktokenst)"\n")(setqtar-header-offset(marker-positionm))))));; after doing the insertion, add any final padding that may be necessary.(tar-pad-to-blocksize))(narrow-to-region1tar-header-offset)))(set-buffer-modified-pt); mark the tar file as modified(set-buffersubfile)(set-buffer-modified-pnil); mark the tar subfile as unmodified(message"saved into tar-buffer \"%s\" - remember to save that buffer!"(buffer-nametar-superior-buffer)))))(defuntar-pad-to-blocksize()"If we are being anal about tar file blocksizes, fix up the current buffer.Leaves the region wide."(if(nulltar-anal-blocksize)nil(widen)(let*((last-desc(nth(1-(lengthtar-parse-info))tar-parse-info))(start(tar-desc-data-startlast-desc))(tokens(tar-desc-tokenslast-desc))(link-p(tar-header-link-typetokens))(size(iflink-p0(tar-header-sizetokens)))(data-end(+startsize))(bbytes(ashtar-anal-blocksize9))(pad-to(+bbytes(*bbytes(/(1-data-end)bbytes))))(buffer-read-onlynil); ##);; If the padding after the last data is too long, delete some;;; else insert some until we are padded out to the right number of blocks.;;(goto-char(+(ortar-header-offset0)data-end))(if(>(1+(buffer-size))(+(ortar-header-offset0)pad-to))(delete-region(+(ortar-header-offset0)pad-to)(1+(buffer-size)))(insert(make-string(-(+(ortar-header-offset0)pad-to)(1+(buffer-size)))0))))))(defuntar-maybe-write-file()"Used as a write-file-hook to write tar-files out correctly.";;;; If the current buffer is in tar-mode and has its header-offset set,;; remove the header from the file, call the remaining write-file hooks,;; and then write out the buffer (if and only if one of the write-file;; hooks didn't write it already). Then put the header back on the;; buffer. Many thanks to Piet van Oostrum for this code, which causes;; correct interaction with crypt.el (and probably anything like it.);;;; Kludge: in XEmacs Emacs, write-file-hooks is bound to nil before the;; write-file-hooks are run, to prevent them from being run recursively;; (this is more of a danger in v19-vintage emacses, which have both;; write-file-hooks and write-contents-hooks.) So, we need to reference;; an internal variable of basic-save-buffer to get the list of hooks;; remaining to be run.;;(and(eqmajor-mode'tar-mode)(and(boundp'tar-header-offset)tar-header-offset)(let*((hooks(cond((string-match"XEmacs"emacs-version);; Internal to basic-save-buffer in XEmacs.(symbol-value'hooks))((string-lessp"19"emacs-version);; I think this is what we need to do in fsfmacs.(appendwrite-contents-hookswrite-file-hooks))(twrite-file-hooks)))(remaining-hooks(cdr(memq'tar-maybe-write-filehooks)))header-stringdone)(save-excursion(save-restriction(widen)(tar-clear-modification-flags)(setqheader-string(buffer-substring1tar-header-offset))(delete-region1tar-header-offset)(unwind-protect(progn(while(andremaining-hooks(not(setqdone(funcall(carremaining-hooks)))))(setqremaining-hooks(cdrremaining-hooks)))(cond((notdone)(write-region1(1+(buffer-size))buffer-file-namenilt)(setqdonet))))(goto-char1)(insertheader-string)(set-buffer-modified-pnil))))done)));;; Patch it in.;;;###autoload(defvartar-regexp"\\.tar$""The regular expression used to identify tar file names.Note that this regular expression must not match compressed tar filenames; if it does, tar-mode will attempt to parse the compressed tarfile as an uncompressed tar file, which will generate an error. Thisis not a problem, as other modules that handle compression willuncompress the buffer and call `tar-mode' appropriately.");;;###autoload(setqauto-mode-alist(cons(constar-regexp'tar-mode)auto-mode-alist));; Note: the tar write-file-hook should go on the list *before* any other;; hooks which might write the file. Since things like crypt-mode add things;; to the end of the write-file-hooks, this will normally be the case.;(or (boundp 'write-file-hooks) (setq write-file-hooks nil));(or (listp write-file-hooks); (setq write-file-hooks (list write-file-hooks)));(or (memq 'tar-maybe-write-file write-file-hooks); (setq write-file-hooks; (cons 'tar-maybe-write-file write-file-hooks)))(add-hook'write-file-hooks'tar-maybe-write-file); ####write-contents-hooks??(cond((boundp'after-save-hook)(add-hook'after-save-hook'tar-subfile-after-write-file-hook))((boundp'after-write-file-hooks)(add-hook'after-write-file-hooks'tar-subfile-after-write-file-hook))(t(error"neither after-save-hook nor after-write-file-hooks?")));;; This is a hack. For files ending in .tar, we want -*- lines to be;;; completely ignored - if there is one, it applies to the first file;;; in the archive, and not the archive itself! Similarly for local;;; variables specifications in the last file of the archive.(defuntar-normal-mode(&optionalfind-file)"Choose the major mode for this buffer automatically.Also sets up any specified local variables of the file.Uses the visited file name, the -*- line, and the local variables spec.This function is called automatically from `find-file'. In that case,if `inhibit-local-variables' is non-`nil' we require confirmation beforeprocessing a local variables spec. If you run `normal-mode' explicitly,confirmation is never required.Note that this version of this function has been hacked to interactcorrectly with tar files - when visiting a file which matches'tar-regexp', the -*- line and local-variables are not examined,as they would apply to a file within the archive rather than the archiveitself."(interactive)(if(andbuffer-file-name(string-matchtar-regexpbuffer-file-name))(tar-mode)(tar-real-normal-modefind-file)));; We have to shadow this as well to get along with crypt.el.;; Shadowing this alone isn't enough, though; we need to shadow ;; tar-normal-mode in order to inhibit the local variables of the;; last file in the tar archive.;;(defuntar-set-auto-mode()"Select major mode appropriate for current buffer.May base decision on visited file name (See variable auto-mode-list)or on buffer contents (-*- line or local variables spec), but does not lookfor the \"mode:\" local variable. For that, use hack-local-variables.Note that this version of this function has been hacked to interactcorrectly with tar files - when visiting a file which matches'tar-regexp', the -*- line and local-variables are not examined,as they would apply to a file within the archive rather than the archiveitself."(interactive)(if(andbuffer-file-name(string-matchtar-regexpbuffer-file-name))(tar-mode)(tar-real-set-auto-mode)))(if(not(fboundp'tar-real-normal-mode))(fset'tar-real-normal-mode(symbol-function'normal-mode)))(fset'normal-mode'tar-normal-mode)(if(not(fboundp'tar-real-set-auto-mode))(fset'tar-real-set-auto-mode(symbol-function'set-auto-mode)))(fset'set-auto-mode'tar-set-auto-mode)(defuntar-quit()"Kill the current tar buffer."(interactive)(kill-buffernil))(provide'tar-mode);;; tar-mode.el ends here