]> code.delx.au - gnu-emacs/blobdiff - lisp/jka-compr.el
(flyspell-mode-on): fix kill-buffer-hook
[gnu-emacs] / lisp / jka-compr.el
index ff602eefce9da70a415792dfe851eda2b76833f6..fc53a0b329a55331302d4605954ffd860a5ec4de 100644 (file)
@@ -3,6 +3,7 @@
 ;; Copyright (C) 1993, 1994, 1995, 1997  Free Software Foundation, Inc.
 
 ;; Author: jka@ece.cmu.edu (Jay K. Adams)
+;; Maintainer: FSF
 ;; Keywords: data
 
 ;; This file is part of GNU Emacs.
@@ -116,11 +117,11 @@ for `jka-compr-compression-info-list')."
   :type 'string
   :group 'jka-compr)
 
-(defvar jka-compr-use-shell t)
-
+(defvar jka-compr-use-shell 
+  (not (memq system-type '(ms-dos windows-nt))))
 
 ;;; I have this defined so that .Z files are assumed to be in unix
-;;; compress format; and .gz files, in gzip format.
+;;; compress format; and .gz files, in gzip format, and .bz2 files in bzip fmt.
 (defcustom jka-compr-compression-info-list
   ;;[regexp
   ;; compr-message  compr-prog  compr-args
@@ -130,6 +131,10 @@ for `jka-compr-compression-info-list')."
      "compressing"    "compress"     ("-c")
      "uncompressing"  "uncompress"   ("-c")
      nil t]
+    ["\\.bz2\\'"
+     "bzip2ing"        "bzip2"         ("-c")
+     "bunzip2ing"      "bzip2"         ("-d" "-c")
+     nil t]
     ["\\.tgz\\'"
      "zipping"        "gzip"         ("-c" "-q")
      "unzipping"      "gzip"         ("-c" "-q" "-d")
@@ -188,7 +193,10 @@ invoked."
 
 (defvar jka-compr-mode-alist-additions
   (list (cons "\\.tgz\\'" 'tar-mode))
-  "A list of pairs to add to auto-mode-alist when jka-compr is installed.")
+  "A list of pairs to add to `auto-mode-alist' when jka-compr is installed.")
+
+;; List of all the elements we actually added to file-coding-system-alist.
+(defvar jka-compr-added-to-file-coding-system-alist nil)
 
 (defvar jka-compr-file-name-handler-entry
   nil
@@ -296,8 +304,10 @@ to keep: LEN chars starting BEG chars from the beginning."
 (defun jka-compr-call-process (prog message infile output temp args)
   (if jka-compr-use-shell
 
-      (let ((err-file (jka-compr-make-temp-name)))
-           
+      (let ((err-file (jka-compr-make-temp-name))
+           (coding-system-for-read (or coding-system-for-read 'undecided))
+            (coding-system-for-write 'no-conversion))
+
        (unwind-protect
 
            (or (memq
@@ -337,8 +347,7 @@ to keep: LEN chars starting BEG chars from the beginning."
 ;;; from ange-ftp.
 
 (defcustom jka-compr-temp-name-template
-  (expand-file-name "jka-com"
-                   (or (getenv "TMPDIR") "/tmp/"))
+  (expand-file-name "jka-com" temporary-file-directory)
   "Prefix added to all temp files created by jka-compr.
 There should be no more than seven characters after the final `/'."
   :type 'string
@@ -404,7 +413,11 @@ There should be no more than seven characters after the final `/'."
                (compress-args (jka-compr-info-compress-args info))
                (uncompress-args (jka-compr-info-uncompress-args info))
                (base-name (file-name-nondirectory visit-file))
-               temp-file temp-buffer)
+               temp-file temp-buffer
+               ;; we need to leave `last-coding-system-used' set to its
+               ;; value after calling write-region the first time, so
+               ;; that `basic-save-buffer' sees the right value.
+               (coding-system-used last-coding-system-used))
 
            (setq temp-buffer (get-buffer-create " *jka-compr-wr-temp*"))
            (with-current-buffer temp-buffer
@@ -427,21 +440,29 @@ There should be no more than seven characters after the final `/'."
            
            (jka-compr-run-real-handler 'write-region
                                        (list start end temp-file t 'dont))
-
-           (jka-compr-call-process compress-program
-                                   (concat compress-message
-                                           " " base-name)
-                                   temp-file
-                                   temp-buffer
-                                   nil
-                                   compress-args)
+           ;; save value used by the real write-region
+           (setq coding-system-used last-coding-system-used)
+
+           ;; Here we must read the output of compress program as is
+           ;; without any code conversion.
+           (let ((coding-system-for-read 'no-conversion))
+             (jka-compr-call-process compress-program
+                                     (concat compress-message
+                                             " " base-name)
+                                     temp-file
+                                     temp-buffer
+                                     nil
+                                     compress-args))
 
            (with-current-buffer temp-buffer
-             (jka-compr-run-real-handler 'write-region
-                                         (list (point-min) (point-max)
-                                               filename
-                                               (and append can-append) 'dont))
-             (erase-buffer))
+              (let ((coding-system-for-write 'no-conversion))
+                (if (memq system-type '(ms-dos windows-nt))
+                    (setq buffer-file-type t) )
+                (jka-compr-run-real-handler 'write-region
+                                            (list (point-min) (point-max)
+                                                  filename
+                                                  (and append can-append) 'dont))
+                (erase-buffer)) )
 
            (jka-compr-delete-temp-file temp-file)
 
@@ -463,6 +484,9 @@ There should be no more than seven characters after the final `/'."
                     (stringp visit))
                 (message "Wrote %s" visit-file))
 
+           ;; ensure `last-coding-system-used' has an appropriate value
+           (setq last-coding-system-used coding-system-used)
+
            nil)
              
        (jka-compr-run-real-handler 'write-region
@@ -489,7 +513,18 @@ There should be no more than seven characters after the final `/'."
              (local-copy
               (jka-compr-run-real-handler 'file-local-copy (list filename)))
              local-file
-             size start)
+             size start
+              (coding-system-for-read
+              (or coding-system-for-read
+                  ;; If multibyte characters are disabled,
+                  ;; don't do that conversion.
+                  (and (null enable-multibyte-characters)
+                       'raw-text)
+                  (let ((coding (find-operation-coding-system
+                                 'insert-file-contents
+                                 (jka-compr-byte-compiler-base-file-name file))))
+                    (and (consp coding) (car coding)))
+                  'undecided)) )
 
          (setq local-file (or local-copy filename))
 
@@ -572,18 +607,22 @@ There should be no more than seven characters after the final `/'."
           (signal 'file-error
                   (cons "Opening input file" (nth 2 notfound))))
 
-         ;; Run the functions that insert-file-contents would.
-         (let ((p after-insert-file-functions)
-               (insval size))
-           (while p
-             (setq insval (funcall (car p) size))
-             (if insval
-                 (progn
-                   (or (integerp insval)
-                       (signal 'wrong-type-argument
-                               (list 'integerp insval)))
-                   (setq size insval)))
-             (setq p (cdr p))))
+         ;; This is done in insert-file-contents after we return.
+         ;; That is a little weird, but better to go along with it now
+         ;; than to change it now.
+
+;;;      ;; Run the functions that insert-file-contents would.
+;;;      (let ((p after-insert-file-functions)
+;;;            (insval size))
+;;;        (while p
+;;;          (setq insval (funcall (car p) size))
+;;;          (if insval
+;;;              (progn
+;;;                (or (integerp insval)
+;;;                    (signal 'wrong-type-argument
+;;;                            (list 'integerp insval)))
+;;;                (setq size insval)))
+;;;          (setq p (cdr p))))
 
          (list filename size))
 
@@ -618,20 +657,28 @@ There should be no more than seven characters after the final `/'."
                 uncompress-message
                 (message "%s %s..." uncompress-message base-name))
                  
-               (jka-compr-call-process uncompress-program
-                                       (concat uncompress-message
-                                               " " base-name)
-                                       local-file
-                                       t
-                                       nil
-                                       uncompress-args)
-
-               (and
-                uncompress-message
-                (message "%s %s...done" uncompress-message base-name))
-
-               (write-region
-                (point-min) (point-max) temp-file nil 'dont))
+               ;; Here we must read the output of uncompress program
+               ;; and write it to TEMP-FILE without any code
+               ;; conversion.  An appropriate code conversion (if
+               ;; necessary) is done by the later I/O operation
+               ;; (e.g. load).
+               (let ((coding-system-for-read 'no-conversion)
+                     (coding-system-for-write 'no-conversion))
+
+                 (jka-compr-call-process uncompress-program
+                                         (concat uncompress-message
+                                                 " " base-name)
+                                         local-file
+                                         t
+                                         nil
+                                         uncompress-args)
+
+                 (and
+                  uncompress-message
+                  (message "%s %s...done" uncompress-message base-name))
+
+                 (write-region
+                  (point-min) (point-max) temp-file nil 'dont)))
 
            (and
             local-copy
@@ -683,10 +730,15 @@ There should be no more than seven characters after the final `/'."
 (put 'byte-compiler-base-file-name 'jka-compr
      'jka-compr-byte-compiler-base-file-name)
 
+(defvar jka-compr-inhibit nil
+  "Non-nil means inhibit automatic uncompression temporarily.
+Lisp programs can bind this to t to do that.
+It is not recommended to set this variable permanently to anything but nil.")
+
 (defun jka-compr-handler (operation &rest args)
   (save-match-data
     (let ((jka-op (get operation 'jka-compr)))
-      (if jka-op
+      (if (and jka-op (not jka-compr-inhibit))
          (apply jka-op args)
        (jka-compr-run-real-handler operation args)))))
 
@@ -767,8 +819,18 @@ and `inhibit-first-line-modes-suffixes'."
   (setq file-name-handler-alist (cons jka-compr-file-name-handler-entry
                                      file-name-handler-alist))
 
+  (setq jka-compr-added-to-file-coding-system-alist nil)
+
   (mapcar
    (function (lambda (x)
+              ;; Don't do multibyte encoding on the compressed files.
+              (let ((elt (cons (jka-compr-info-regexp x)
+                                '(no-conversion . no-conversion))))
+                (setq file-coding-system-alist
+                      (cons elt file-coding-system-alist))
+                (setq jka-compr-added-to-file-coding-system-alist
+                      (cons elt jka-compr-added-to-file-coding-system-alist)))
+
               (and (jka-compr-info-strip-extension x)
                    ;; Make entries in auto-mode-alist so that modes
                    ;; are chosen right according to the file names
@@ -826,7 +888,19 @@ by `jka-compr-installed'."
          (setcdr last (cdr (cdr last)))
        (setq last (cdr last))))
     
-    (setq auto-mode-alist (cdr ama))))
+    (setq auto-mode-alist (cdr ama)))
+
+  (let* ((ama (cons nil file-coding-system-alist))
+        (last ama)
+        entry)
+
+    (while (cdr last)
+      (setq entry (car (cdr last)))
+      (if (member entry jka-compr-added-to-file-coding-system-alist)
+         (setcdr last (cdr (cdr last)))
+       (setq last (cdr last))))
+    
+    (setq file-coding-system-alist (cdr ama))))
 
       
 (defun jka-compr-installed-p ()