(iswitchb-visit-buffer): Use `select-frame-set-input-focus'.

[gnu-emacs] / lisp / jka-compr.el

diff --git a/lisp/jka-compr.el b/lisp/jka-compr.el
index ae63d71c92e332f50f332a6ea8b4e686074955e2..5c42a0af8be35cc5c7e39d0737009f05167c8a79 100644 (file)
--- a/lisp/jka-compr.el
+++ b/lisp/jka-compr.el
@@ -23,7 +23,7 @@
 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
 
 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
 

-;;; Commentary: 
+;;; Commentary:

 
 ;; This package implements low-level support for reading, writing,
 ;; and loading compressed files.  It hooks into the low-level file
 
 ;; This package implements low-level support for reading, writing,
 ;; and loading compressed files.  It hooks into the low-level file


@@ -198,9 +198,16 @@ invoked."
                         (string :tag "Magic Bytes")))
   :group 'jka-compr)
 
                         (string :tag "Magic Bytes")))
   :group 'jka-compr)
 

-(defvar jka-compr-mode-alist-additions
+(defcustom jka-compr-mode-alist-additions

   (list (cons "\\.tgz\\'" 'tar-mode))
   (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."
+  :type '(repeat (cons string symbol))
+  :group 'jka-compr)
+
+(defcustom jka-compr-load-suffixes '(".gz")
+  "List of suffixes to try when loading files."
+  :type '(repeat string)
+  :group 'jka-compr)

 
 ;; List of all the elements we actually added to file-coding-system-alist.
 (defvar jka-compr-added-to-file-coding-system-alist nil)
 
 ;; List of all the elements we actually added to file-coding-system-alist.
 (defvar jka-compr-added-to-file-coding-system-alist nil)


@@ -265,8 +272,10 @@ based on the filename itself and `jka-compr-compression-info-list'."
          (list "Opening input file" (format "error %s" message) infile)))
                        
    
          (list "Opening input file" (format "error %s" message) infile)))
                        
    

-(defvar jka-compr-dd-program
-  "/bin/dd")
+(defcustom jka-compr-dd-program "/bin/dd"
+  "How to invoke `dd'."
+  :type 'string
+  :group 'jka-compr)

 
 
 (defvar jka-compr-dd-blocksize 256)
 
 
 (defvar jka-compr-dd-blocksize 256)


@@ -276,32 +285,38 @@ based on the filename itself and `jka-compr-compression-info-list'."
   "Call program PROG with ARGS args taking input from INFILE.
 Fourth and fifth args, BEG and LEN, specify which part of the output
 to keep: LEN chars starting BEG chars from the beginning."
   "Call program PROG with ARGS args taking input from INFILE.
 Fourth and fifth args, BEG and LEN, specify which part of the output
 to keep: LEN chars starting BEG chars from the beginning."

-  (let* ((skip (/ beg jka-compr-dd-blocksize))
-        (prefix (- beg (* skip jka-compr-dd-blocksize)))
-        (count (and len (1+ (/ (+ len prefix) jka-compr-dd-blocksize))))
-        (start (point))
-        (err-file (jka-compr-make-temp-name))
-        (run-string (format "%s %s 2> %s | %s bs=%d skip=%d %s 2> /dev/null"
-                            prog
-                            (mapconcat 'identity args " ")
-                            err-file
-                            jka-compr-dd-program
-                            jka-compr-dd-blocksize
-                            skip
-                            ;; dd seems to be unreliable about
-                            ;; providing the last block.  So, always
-                            ;; read one more than you think you need.
-                            (if count (format "count=%d" (1+ count)) ""))))
-
-    (unwind-protect
-       (or (memq (call-process jka-compr-shell
-                               infile t nil "-c"
-                               run-string)
-                 jka-compr-acceptable-retval-list)
-           
-           (jka-compr-error prog args infile message err-file))
-
-      (jka-compr-delete-temp-file err-file))
+  (let ((start (point))
+       (prefix beg))
+    (if (and jka-compr-use-shell jka-compr-dd-program)
+       ;; Put the uncompression output through dd
+       ;; to discard the part we don't want.
+       (let ((skip (/ beg jka-compr-dd-blocksize))
+             (err-file (jka-compr-make-temp-name))
+             count)
+         ;; Update PREFIX based on the text that we won't read in.
+         (setq prefix (- beg (* skip jka-compr-dd-blocksize))
+               count (and len (1+ (/ (+ len prefix) jka-compr-dd-blocksize))))
+         (unwind-protect
+             (or (memq (call-process
+                        jka-compr-shell infile t nil "-c"
+                        (format
+                         "%s %s 2> %s | %s bs=%d skip=%d %s 2> /dev/null"
+                         prog
+                         (mapconcat 'identity args " ")
+                         err-file
+                         jka-compr-dd-program
+                         jka-compr-dd-blocksize
+                         skip
+                         ;; dd seems to be unreliable about
+                         ;; providing the last block.  So, always
+                         ;; read one more than you think you need.
+                         (if count (format "count=%d" (1+ count)) "")))
+                       jka-compr-acceptable-retval-list)
+                 (jka-compr-error prog args infile message err-file))
+           (jka-compr-delete-temp-file err-file)))
+      ;; Run the uncompression program directly.
+      ;; We get the whole file and must delete what we don't want.
+      (jka-compr-call-process prog message infile t nil args))

 
     ;; Delete the stuff after what we want, if there is any.
     (and
 
     ;; Delete the stuff after what we want, if there is any.
     (and


@@ -804,7 +819,16 @@ and `inhibit-first-line-modes-suffixes'."
                                inhibit-first-line-modes-suffixes)))))
    jka-compr-compression-info-list)
   (setq auto-mode-alist
                                inhibit-first-line-modes-suffixes)))))
    jka-compr-compression-info-list)
   (setq auto-mode-alist

-       (append auto-mode-alist jka-compr-mode-alist-additions)))
+       (append auto-mode-alist jka-compr-mode-alist-additions))
+
+  ;; Make sure that (load "foo") will find /bla/foo.el.gz.
+  (setq load-suffixes
+       (apply 'append
+              (mapcar (lambda (suffix)
+                        (cons suffix
+                              (mapcar (lambda (ext) (concat suffix ext))
+                                      jka-compr-load-suffixes)))
+                      load-suffixes))))

 
 
 (defun jka-compr-uninstall ()
 
 
 (defun jka-compr-uninstall ()


@@ -856,7 +880,15 @@ by `jka-compr-installed'."
          (setcdr last (cdr (cdr last)))
        (setq last (cdr last))))
     
          (setcdr last (cdr (cdr last)))
        (setq last (cdr last))))
     

-    (setq file-coding-system-alist (cdr ama))))
+    (setq file-coding-system-alist (cdr ama)))
+
+  ;; Remove the suffixes that were added by jka-compr.
+  (let ((suffixes nil)
+       (re (jka-compr-build-file-regexp)))
+    (dolist (suffix load-suffixes)
+      (unless (string-match re suffix)
+       (push suffix suffixes)))
+    (setq load-suffixes (nreverse suffixes))))

 
       
 (defun jka-compr-installed-p ()
 
       
 (defun jka-compr-installed-p ()


@@ -881,10 +913,6 @@ The return value is the entry in `file-name-handler-alist' for jka-compr."
      (jka-compr-uninstall))
 
 
      (jka-compr-uninstall))
 
 

-;;; Note this definition must be at the end of the file, because
-;;; `define-minor-mode' actually calls the mode-function if the
-;;; associated variable is non-nil, which requires that all needed
-;;; functions be already defined.  [This is arguably a bug in d-m-m]

 ;;;###autoload
 (define-minor-mode auto-compression-mode
   "Toggle automatic file compression and uncompression.
 ;;;###autoload
 (define-minor-mode auto-compression-mode
   "Toggle automatic file compression and uncompression.


@@ -917,4 +945,4 @@ Returns the new status of auto compression (non-nil means on)."
 
 (provide 'jka-compr)
 
 
 (provide 'jka-compr)
 

-;; jka-compr.el ends here.
+;;; jka-compr.el ends here