1 |
;;; jka-compr.el --- reading/writing/loading compressed files |
;;; jka-compr.el --- reading/writing/loading compressed files |
2 |
|
|
3 |
;; Copyright (C) 1993, 1994, 1995, 1997, 1999, 2000 Free Software Foundation, Inc. |
;; Copyright (C) 1993, 1994, 1995, 1997, 1999, 2000, 2003 Free Software Foundation, Inc. |
4 |
|
|
5 |
;; Author: jka@ece.cmu.edu (Jay K. Adams) |
;; Author: jka@ece.cmu.edu (Jay K. Adams) |
6 |
;; Maintainer: FSF |
;; Maintainer: FSF |
77 |
|
|
78 |
|
|
79 |
;; ACKNOWLEDGMENTS |
;; ACKNOWLEDGMENTS |
80 |
;; |
;; |
81 |
;; jka-compr is a V19 adaptation of jka-compr for V18 of Emacs. Many people |
;; jka-compr is a V19 adaptation of jka-compr for V18 of Emacs. Many people |
82 |
;; have made helpful suggestions, reported bugs, and even fixed bugs in |
;; have made helpful suggestions, reported bugs, and even fixed bugs in |
83 |
;; jka-compr. I recall the following people as being particularly helpful. |
;; jka-compr. I recall the following people as being particularly helpful. |
84 |
;; |
;; |
85 |
;; Jean-loup Gailly |
;; Jean-loup Gailly |
117 |
:type 'string |
:type 'string |
118 |
:group 'jka-compr) |
:group 'jka-compr) |
119 |
|
|
120 |
(defvar jka-compr-use-shell |
(defvar jka-compr-use-shell |
121 |
(not (memq system-type '(ms-dos windows-nt)))) |
(not (memq system-type '(ms-dos windows-nt)))) |
122 |
|
|
123 |
;;; I have this defined so that .Z files are assumed to be in unix |
;;; I have this defined so that .Z files are assumed to be in unix |
270 |
|
|
271 |
(signal 'compression-error |
(signal 'compression-error |
272 |
(list "Opening input file" (format "error %s" message) infile))) |
(list "Opening input file" (format "error %s" message) infile))) |
273 |
|
|
274 |
|
|
275 |
(defcustom jka-compr-dd-program "/bin/dd" |
(defcustom jka-compr-dd-program "/bin/dd" |
276 |
"How to invoke `dd'." |
"How to invoke `dd'." |
277 |
:type 'string |
:type 'string |
447 |
|
|
448 |
(setq temp-file (jka-compr-make-temp-name))) |
(setq temp-file (jka-compr-make-temp-name))) |
449 |
|
|
450 |
(and |
(and |
451 |
compress-message |
compress-message |
452 |
(message "%s %s..." compress-message base-name)) |
(message "%s %s..." compress-message base-name)) |
453 |
|
|
502 |
(setq last-coding-system-used coding-system-used) |
(setq last-coding-system-used coding-system-used) |
503 |
|
|
504 |
nil) |
nil) |
505 |
|
|
506 |
(jka-compr-run-real-handler 'write-region |
(jka-compr-run-real-handler 'write-region |
507 |
(list start end filename append visit))))) |
(list start end filename append visit))))) |
508 |
|
|
527 |
(local-copy |
(local-copy |
528 |
(jka-compr-run-real-handler 'file-local-copy (list filename))) |
(jka-compr-run-real-handler 'file-local-copy (list filename))) |
529 |
local-file |
local-file |
530 |
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) |
|
|
(or (auto-coding-alist-lookup |
|
|
(jka-compr-byte-compiler-base-file-name file)) |
|
|
'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)) ) |
|
531 |
|
|
532 |
(setq local-file (or local-copy filename)) |
(setq local-file (or local-copy filename)) |
533 |
|
|
538 |
(unwind-protect ; to make sure local-copy gets deleted |
(unwind-protect ; to make sure local-copy gets deleted |
539 |
|
|
540 |
(progn |
(progn |
541 |
|
|
542 |
(and |
(and |
543 |
uncompress-message |
uncompress-message |
544 |
(message "%s %s..." uncompress-message base-name)) |
(message "%s %s..." uncompress-message base-name)) |
545 |
|
|
546 |
(condition-case error-code |
(condition-case error-code |
547 |
|
|
548 |
(progn |
(let ((coding-system-for-read 'no-conversion)) |
549 |
(if replace |
(if replace |
550 |
(goto-char (point-min))) |
(goto-char (point-min))) |
551 |
(setq start (point)) |
(setq start (point)) |
583 |
(eq (nth 3 error-code) local-file)) |
(eq (nth 3 error-code) local-file)) |
584 |
(if visit |
(if visit |
585 |
(setq notfound error-code) |
(setq notfound error-code) |
586 |
(signal 'file-error |
(signal 'file-error |
587 |
(cons "Opening input file" |
(cons "Opening input file" |
588 |
(nthcdr 2 error-code)))) |
(nthcdr 2 error-code)))) |
589 |
(signal (car error-code) (cdr error-code)))))) |
(signal (car error-code) (cdr error-code)))))) |
593 |
(file-exists-p local-copy) |
(file-exists-p local-copy) |
594 |
(delete-file local-copy))) |
(delete-file local-copy))) |
595 |
|
|
596 |
|
(decode-coding-inserted-region |
597 |
|
(point) (+ (point) size) |
598 |
|
(jka-compr-byte-compiler-base-file-name file) |
599 |
|
visit beg end replace) |
600 |
|
|
601 |
(and |
(and |
602 |
visit |
visit |
603 |
(progn |
(progn |
605 |
(setq buffer-file-name filename) |
(setq buffer-file-name filename) |
606 |
(setq jka-compr-really-do-compress t) |
(setq jka-compr-really-do-compress t) |
607 |
(set-visited-file-modtime))) |
(set-visited-file-modtime))) |
608 |
|
|
609 |
(and |
(and |
610 |
uncompress-message |
uncompress-message |
611 |
(message "%s %s...done" uncompress-message base-name)) |
(message "%s %s...done" uncompress-message base-name)) |
661 |
(unwind-protect |
(unwind-protect |
662 |
|
|
663 |
(with-current-buffer temp-buffer |
(with-current-buffer temp-buffer |
664 |
|
|
665 |
(and |
(and |
666 |
uncompress-message |
uncompress-message |
667 |
(message "%s %s..." uncompress-message base-name)) |
(message "%s %s..." uncompress-message base-name)) |
668 |
|
|
669 |
;; Here we must read the output of uncompress program |
;; Here we must read the output of uncompress program |
670 |
;; and write it to TEMP-FILE without any code |
;; and write it to TEMP-FILE without any code |
671 |
;; conversion. An appropriate code conversion (if |
;; conversion. An appropriate code conversion (if |
697 |
(kill-buffer temp-buffer)) |
(kill-buffer temp-buffer)) |
698 |
|
|
699 |
temp-file) |
temp-file) |
700 |
|
|
701 |
(jka-compr-run-real-handler 'file-local-copy (list filename))))) |
(jka-compr-run-real-handler 'file-local-copy (list filename))))) |
702 |
|
|
703 |
|
|
749 |
Lisp programs can bind this to t to do that. |
Lisp programs can bind this to t to do that. |
750 |
It is not recommended to set this variable permanently to anything but nil.") |
It is not recommended to set this variable permanently to anything but nil.") |
751 |
|
|
752 |
|
(put 'jka-compr-handler 'safe-magic t) |
753 |
(defun jka-compr-handler (operation &rest args) |
(defun jka-compr-handler (operation &rest args) |
754 |
(save-match-data |
(save-match-data |
755 |
(let ((jka-op (get operation 'jka-compr))) |
(let ((jka-op (get operation 'jka-compr))) |
865 |
(eq (nth 2 entry) 'jka-compr))) |
(eq (nth 2 entry) 'jka-compr))) |
866 |
(setcdr last (cdr (cdr last))) |
(setcdr last (cdr (cdr last))) |
867 |
(setq last (cdr last)))) |
(setq last (cdr last)))) |
868 |
|
|
869 |
(setq auto-mode-alist (cdr ama))) |
(setq auto-mode-alist (cdr ama))) |
870 |
|
|
871 |
(let* ((ama (cons nil file-coding-system-alist)) |
(let* ((ama (cons nil file-coding-system-alist)) |
877 |
(if (member entry jka-compr-added-to-file-coding-system-alist) |
(if (member entry jka-compr-added-to-file-coding-system-alist) |
878 |
(setcdr last (cdr (cdr last))) |
(setcdr last (cdr (cdr last))) |
879 |
(setq last (cdr last)))) |
(setq last (cdr last)))) |
880 |
|
|
881 |
(setq file-coding-system-alist (cdr ama))) |
(setq file-coding-system-alist (cdr ama))) |
882 |
|
|
883 |
;; Remove the suffixes that were added by jka-compr. |
;; Remove the suffixes that were added by jka-compr. |
888 |
(push suffix suffixes))) |
(push suffix suffixes))) |
889 |
(setq load-suffixes (nreverse suffixes)))) |
(setq load-suffixes (nreverse suffixes)))) |
890 |
|
|
891 |
|
|
892 |
(defun jka-compr-installed-p () |
(defun jka-compr-installed-p () |
893 |
"Return non-nil if jka-compr is installed. |
"Return non-nil if jka-compr is installed. |
894 |
The return value is the entry in `file-name-handler-alist' for jka-compr." |
The return value is the entry in `file-name-handler-alist' for jka-compr." |