X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/75e9c107ee12a46b088644cf3dadef53eed8c9b8..1b33e237605724471fa486643252702feca7a6e1:/lisp/jka-compr.el diff --git a/lisp/jka-compr.el b/lisp/jka-compr.el index cc0a03a549..caa0711081 100644 --- a/lisp/jka-compr.el +++ b/lisp/jka-compr.el @@ -1,8 +1,9 @@ ;;; jka-compr.el --- reading/writing/loading compressed files -;; Copyright (C) 1993, 1994 Free Software Foundation, Inc. +;; 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. @@ -99,19 +100,29 @@ ;;; Code: -(defvar jka-compr-shell "sh" +(defgroup compression nil + "Data compression utilities" + :group 'data) + +(defgroup jka-compr nil + "jka-compr customization" + :group 'compression) + + +(defcustom jka-compr-shell "sh" "*Shell to be used for calling compression programs. The value of this variable only matters if you want to discard the stderr of a compression/decompression program (see the documentation -for `jka-compr-compression-info-list').") - - -(defvar jka-compr-use-shell t) +for `jka-compr-compression-info-list')." + :type 'string + :group 'jka-compr) +(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. -(defvar jka-compr-compression-info-list +;;; 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 ;; uncomp-message uncomp-prog uncomp-args @@ -120,6 +131,13 @@ for `jka-compr-compression-info-list').") "compressing" "compress" ("-c") "uncompressing" "uncompress" ("-c") nil t] + ;; Formerly, these had an additional arg "-c", but that fails with + ;; "Version 0.1pl2, 29-Aug-97." (RedHat 5.1 GNU/Linux) and + ;; "Version 0.9.0b, 9-Sept-98". + ["\\.bz2\\'" + "bzip2ing" "bzip2" nil + "bunzip2ing" "bzip2" ("-d") + nil t] ["\\.tgz\\'" "zipping" "gzip" ("-c" "-q") "unzipping" "gzip" ("-c" "-q" "-d") @@ -160,11 +178,28 @@ APPEND-FLAG EXTENSION], where: Because of the way `call-process' is defined, discarding the stderr output of a program adds the overhead of starting a shell each time the program is -invoked.") +invoked." + :type '(repeat (vector regexp + (choice :tag "Compress Message" + (string :format "%v") + (const :tag "No Message" nil)) + (string :tag "Compress Program") + (repeat :tag "Compress Arguments" string) + (choice :tag "Uncompress Message" + (string :format "%v") + (const :tag "No Message" nil)) + (string :tag "Uncompress Program") + (repeat :tag "Uncompress Arguments" string) + (boolean :tag "Append") + (boolean :tag "Auto Mode"))) + :group 'jka-compr) (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 @@ -272,8 +307,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 @@ -312,11 +349,12 @@ to keep: LEN chars starting BEG chars from the beginning." ;;; Support for temp files. Much of this was inspired if not lifted ;;; from ange-ftp. -(defvar jka-compr-temp-name-template - (expand-file-name "jka-com" - (or (getenv "TMPDIR") "/tmp/")) +(defcustom jka-compr-temp-name-template + (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 `/'") +There should be no more than seven characters after the final `/'." + :type 'string + :group 'jka-compr) (defvar jka-compr-temp-name-table (make-vector 31 nil)) @@ -378,7 +416,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 @@ -401,21 +443,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) @@ -437,6 +487,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 @@ -463,7 +516,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)) @@ -546,18 +610,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)) @@ -592,20 +660,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 @@ -657,10 +733,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))))) @@ -741,8 +822,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 @@ -800,7 +891,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 ()