/[emacs]/emacs/lisp/jka-compr.el
ViewVC logotype

Diff of /emacs/lisp/jka-compr.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.70 by eliz, Sun Jun 9 17:13:56 2002 UTC revision 1.70.2.1 by miles, Fri Apr 4 06:20:08 2003 UTC
# Line 1  Line 1 
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
# Line 77  Line 77 
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
# Line 117  for `jka-compr-compression-info-list')." Line 117  for `jka-compr-compression-info-list')."
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
# Line 270  based on the filename itself and `jka-co Line 270  based on the filename itself and `jka-co
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
# Line 447  There should be no more than seven chara Line 447  There should be no more than seven chara
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    
# Line 502  There should be no more than seven chara Line 502  There should be no more than seven chara
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    
# Line 527  There should be no more than seven chara Line 527  There should be no more than seven chara
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    
# Line 551  There should be no more than seven chara Line 538  There should be no more than seven chara
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))
# Line 596  There should be no more than seven chara Line 583  There should be no more than seven chara
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))))))
# Line 606  There should be no more than seven chara Line 593  There should be no more than seven chara
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
# Line 613  There should be no more than seven chara Line 605  There should be no more than seven chara
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))
# Line 669  There should be no more than seven chara Line 661  There should be no more than seven chara
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
# Line 705  There should be no more than seven chara Line 697  There should be no more than seven chara
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    
# Line 757  There should be no more than seven chara Line 749  There should be no more than seven chara
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)))
# Line 872  by `jka-compr-installed'." Line 865  by `jka-compr-installed'."
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))
# Line 884  by `jka-compr-installed'." Line 877  by `jka-compr-installed'."
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.
# Line 895  by `jka-compr-installed'." Line 888  by `jka-compr-installed'."
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."

Legend:
Removed from v.1.70  
changed lines
  Added in v.1.70.2.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26