(find-function-search-for-symbol): Strip extension from .emacs.el to
[bpt/emacs.git] / lisp / tar-mode.el
index cffc8a4..41476f4 100644 (file)
@@ -1,7 +1,7 @@
 ;;; tar-mode.el --- simple editing of tar files from GNU emacs
 
 ;; Copyright (C) 1990, 1991, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
-;;   2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+;;   2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
 
 ;; Author: Jamie Zawinski <jwz@lucid.com>
 ;; Maintainer: FSF
@@ -12,7 +12,7 @@
 
 ;; GNU Emacs 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)
+;; the Free Software Foundation; either version 3, or (at your option)
 ;; any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
@@ -363,6 +363,7 @@ MODE should be an integer which is a file mode value."
                  ((eq type 29) ?M)     ; multivolume continuation
                  ((eq type 35) ?S)     ; sparse
                  ((eq type 38) ?V)     ; volume header
+                 ((eq type 55) ?H)     ; extended pax header
                  (t ?\s)
                  )
            (tar-grind-file-mode mode)
@@ -421,7 +422,7 @@ is visible (and the real data of the buffer is hidden)."
                                   (buffer-substring pos (+ pos 512)))))))
         (setq pos (+ pos 512))
         (progress-reporter-update progress-reporter pos)
-        (if (eq (tar-header-link-type tokens) 20)
+        (if (memq (tar-header-link-type tokens) '(20 55))
             ;; Foo.  There's an extra empty block after these.
             (setq pos (+ pos 512)))
         (let ((size (tar-header-size tokens)))
@@ -657,15 +658,16 @@ appear on disk when you save the tar-file's buffer."
         (size (tar-header-size tokens))
         (link-p (tar-header-link-type tokens)))
     (if link-p
-       (error "This is a %s, not a real file"
-              (cond ((eq link-p 5) "directory")
-                    ((eq link-p 20) "tar directory header")
-                    ((eq link-p 28) "next has longname")
-                    ((eq link-p 29) "multivolume-continuation")
-                    ((eq link-p 35) "sparse entry")
-                    ((eq link-p 38) "volume header")
-                    (t "link"))))
-    (if (zerop size) (error "This is a zero-length file"))
+       (error "This is %s, not a real file"
+              (cond ((eq link-p 5) "a directory")
+                    ((eq link-p 20) "a tar directory header")
+                    ((eq link-p 28) "a next has longname")
+                    ((eq link-p 29) "a multivolume-continuation")
+                    ((eq link-p 35) "a sparse entry")
+                    ((eq link-p 38) "a volume header")
+                    ((eq link-p 55) "an extended pax header")
+                    (t "a link"))))
+    (if (zerop size) (message "This is a zero-length file"))
     descriptor))
 
 (defun tar-mouse-extract (event)
@@ -681,6 +683,12 @@ appear on disk when you save the tar-file's buffer."
   (goto-char (posn-point (event-end event)))
   (tar-extract))
 
+(defun tar-file-name-handler (op &rest args)
+  "Helper function for `tar-extract'."
+  (or (eq op 'file-exists-p)
+      (let ((file-name-handler-alist nil))
+       (apply op args))))
+
 (defun tar-extract (&optional other-window-p)
   "In Tar mode, extract this entry of the tar file into its own buffer."
   (interactive)
@@ -735,9 +743,19 @@ appear on disk when you save the tar-file's buffer."
                                  (save-excursion
                                    (funcall set-auto-coding-function
                                             name (- (point-max) (point)))))
-                            (car (find-operation-coding-system
-                                  'insert-file-contents
-                                  (cons name (current-buffer)) t))))
+                            ;; The following binding causes
+                            ;; find-buffer-file-type-coding-system
+                            ;; (defined on dos-w32.el) to act as if
+                            ;; the file being extracted existed, so
+                            ;; that the file's contents' encoding and
+                            ;; EOL format are auto-detected.
+                            (let ((file-name-handler-alist
+                                   (if (featurep 'dos-w32)
+                                       '(("" . tar-file-name-handler))
+                                     file-name-handler-alist)))
+                              (car (find-operation-coding-system
+                                    'insert-file-contents
+                                    (cons name (current-buffer)) t)))))
                        (multibyte enable-multibyte-characters)
                        (detected (detect-coding-region
                                   (point-min)
@@ -758,7 +776,9 @@ appear on disk when you save the tar-file's buffer."
                              (coding-system-change-text-conversion
                               coding 'raw-text)))
                    (decode-coding-region (point-min) (point-max) coding)
-                   (set-buffer-file-coding-system coding))
+                   ;; Force buffer-file-coding-system to what
+                   ;; decode-coding-region actually used.
+                   (set-buffer-file-coding-system last-coding-system-used t))
                  ;; Set the default-directory to the dir of the
                  ;; superior buffer.
                  (setq default-directory