emacs-pretest-bug
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: autoload and auto-compression-mode


From: Luc Teirlinck
Subject: Re: autoload and auto-compression-mode
Date: Sat, 18 Feb 2006 20:58:03 -0600 (CST)

The following 11 patches implement the new behavior of `load-suffixes'
we agreed on, fixing some reported bugs.  They make setting
load-suffixes take effect immediately without any need to call any
updating functions.

I can install the patches if desired.  Once they are installed, I would
also update various docstrings and loading.texi.

The patches to jka-compr.el and jka-cmpr-hook.el also fix updating
bugs for jka-compr-load-suffixes and two other jka related
customizable options.  These are not unrelated bugfixes, but a
necessary complement to my above fix.

There are two types of bugs for these three options.  First,
currently Emacs ignores any user customization for these three
options: customizing these options only has an effect if done _before_
enabling Auto Compression mode.  But Auto Compression mode is enabled
at startup before the user's .emacs file is read, hence the
customizations in .emacs are ignored.  Another serious bug in these
three variables is that if you change them while Auto Compression mode
is enabled and then disable Auto Compression mode, then Auto
Compression mode may not be correctly disabled.

My patches fix both kind of bugs by giving the three defcustoms a :set
function that provides for automatic updating, making the new values
take effect immediately, and by making Auto Compression mode store the
values of the three variables at the time it was enabled.  That way
Auto Compression mode can correctly remove everything it added to
various other variables.  If you set these three jka customizable
options _outside_ Custom, you still (after my patches) have to call an
updating function to make the new values take effect immediately.
Short of essentially completely rewriting jka-*, I do not know what to
do about that.  At least, now there is an updating function and it
works correctly.

===File ~/lread.c-diff======================================
Index: lread.c
===================================================================
RCS file: /sources/emacs/emacs/src/lread.c,v
retrieving revision 1.349
diff -c -r1.349 lread.c
*** lread.c     6 Feb 2006 15:23:21 -0000       1.349
--- lread.c     19 Feb 2006 02:15:01 -0000
***************
*** 98,104 ****
  Lisp_Object Vsource_directory;
  
  /* Search path and suffixes for files to be loaded. */
! Lisp_Object Vload_path, Vload_suffixes, default_suffixes;
  
  /* File name of user's init file.  */
  Lisp_Object Vuser_init_file;
--- 98,104 ----
  Lisp_Object Vsource_directory;
  
  /* Search path and suffixes for files to be loaded. */
! Lisp_Object Vload_path, Vload_suffixes, Vload_file_rep_suffixes;
  
  /* File name of user's init file.  */
  Lisp_Object Vuser_init_file;
***************
*** 653,658 ****
--- 653,680 ----
    return Qnil;
  }
  
+ DEFUN ("get-load-suffixes", Fget_load_suffixes, Sget_load_suffixes, 0, 0, 0,
+        doc: /* Return the suffixes that `load' should try if a suffix is \
+ required.
+ This uses the variables `load-suffixes' and `load-file-rep-suffixes'.  */)
+      ()
+ {
+   Lisp_Object lst = Qnil, suffixes = Vload_suffixes, suffix, ext;
+   while (CONSP (suffixes))
+     {
+       Lisp_Object exts = Vload_file_rep_suffixes;
+       suffix = XCAR (suffixes);
+       suffixes = XCDR (suffixes);
+       while (CONSP (exts))
+       {
+         ext = XCAR (exts);
+         exts = XCDR (exts);
+         lst = Fcons (concat2 (suffix, ext), lst);
+       }
+     }
+   return Fnreverse (lst);
+ }
+ 
  DEFUN ("load", Fload, Sload, 1, 5, 0,
         doc: /* Execute a file of Lisp code named FILE.
  First try FILE with `.elc' appended, then try with `.el',
***************
*** 749,757 ****
  
        fd = openp (Vload_path, file,
                  (!NILP (nosuffix) ? Qnil
!                  : !NILP (must_suffix) ? Vload_suffixes
!                  : Fappend (2, (tmp[0] = Vload_suffixes,
!                                 tmp[1] = default_suffixes,
                                  tmp))),
                  &found, Qnil);
        UNGCPRO;
--- 771,779 ----
  
        fd = openp (Vload_path, file,
                  (!NILP (nosuffix) ? Qnil
!                  : !NILP (must_suffix) ? Fget_load_suffixes ()
!                  : Fappend (2, (tmp[0] = Fget_load_suffixes (),
!                                 tmp[1] = Vload_file_rep_suffixes,
                                  tmp))),
                  &found, Qnil);
        UNGCPRO;
***************
*** 1109,1115 ****
        fn = (char *) alloca (fn_size = 100 + want_size);
  
        /* Loop over suffixes.  */
!       for (tail = NILP (suffixes) ? default_suffixes : suffixes;
           CONSP (tail); tail = XCDR (tail))
        {
          int lsuffix = SBYTES (XCAR (tail));
--- 1131,1137 ----
        fn = (char *) alloca (fn_size = 100 + want_size);
  
        /* Loop over suffixes.  */
!       for (tail = NILP (suffixes) ? Vload_file_rep_suffixes : suffixes;
           CONSP (tail); tail = XCDR (tail))
        {
          int lsuffix = SBYTES (XCAR (tail));
***************
*** 3840,3845 ****
--- 3862,3868 ----
    defsubr (&Sintern);
    defsubr (&Sintern_soft);
    defsubr (&Sunintern);
+   defsubr (&Sget_load_suffixes);
    defsubr (&Sload);
    defsubr (&Seval_buffer);
    defsubr (&Seval_region);
***************
*** 3902,3913 ****
  
    DEFVAR_LISP ("load-suffixes", &Vload_suffixes,
               doc: /* List of suffixes to try for files to load.
! This list should not include the empty string.  */);
    Vload_suffixes = Fcons (build_string (".elc"),
                          Fcons (build_string (".el"), Qnil));
    /* We don't use empty_string because it's not initialized yet.  */
!   default_suffixes = Fcons (build_string (""), Qnil);
!   staticpro (&default_suffixes);
  
    DEFVAR_BOOL ("load-in-progress", &load_in_progress,
               doc: /* Non-nil iff inside of `load'.  */);
--- 3925,3968 ----
  
    DEFVAR_LISP ("load-suffixes", &Vload_suffixes,
               doc: /* *List of suffixes to try for files to load.
! These are the suffixes that count as \"true\" suffixes when loading a file.
! 
! This list should not include the empty string, nor suffixes that just
! indicate different versions of the same file (for instance compressed
! versions).  The variable `load-file-rep-suffixes' handles these suffixes.
! 
! If a \"true\" suffix is required, loading tries out all possible
! concatenations of the specified file name, a suffix in this list and a
! suffix in `load-file-rep-suffixes'.  If a suffix is allowed but not
! required, loading first tries out all file names described above and
! then all concatenations of the specified file name and a suffix in
! `load-file-rep-suffixes'.  If no suffix is allowed, loading only tries
! the latter file names.
! 
! The function `get-load-suffixes' returns a list of all suffixes that
! loading should try if a \"true\" suffix is required, given the current
! values of this variable and `load-file-rep-suffixes'.  */);
    Vload_suffixes = Fcons (build_string (".elc"),
                          Fcons (build_string (".el"), Qnil));
+   DEFVAR_LISP ("load-file-rep-suffixes", &Vload_file_rep_suffixes,
+              doc: /* List of suffixes that indicate representations of\
+ the same file.
+ These are suffixes that do not count as \"true\" suffixes when loading
+ a file.  Normally, this should include the empty string.
+ 
+ If a \"true\" suffix is required, loading tries out all possible
+ concatenations of the specified file name, a suffix in `load-suffixes'
+ and a suffix in the present list.  If a suffix is allowed but not
+ required, loading first tries out all file names described above and
+ then all concatenations of the specified file name and a suffix in the
+ present list.  If no suffix is allowed, loading only tries the latter
+ file names.
+ 
+ The function `get-load-suffixes' returns a list of all suffixes that
+ loading should try if a \"true\" suffix is required, given the current
+ values of this variable and `load-suffixes'.  */);
    /* We don't use empty_string because it's not initialized yet.  */
!   Vload_file_rep_suffixes = Fcons (build_string (""), Qnil);
  
    DEFVAR_BOOL ("load-in-progress", &load_in_progress,
               doc: /* Non-nil iff inside of `load'.  */);
============================================================

===File ~/lisp.h-diff=======================================
Index: lisp.h
===================================================================
RCS file: /sources/emacs/emacs/src/lisp.h,v
retrieving revision 1.550
diff -c -r1.550 lisp.h
*** lisp.h      10 Feb 2006 00:00:30 -0000      1.550
--- lisp.h      19 Feb 2006 02:13:45 -0000
***************
*** 2603,2608 ****
--- 2603,2609 ----
  EXFUN (Fintern, 2);
  EXFUN (Fintern_soft, 2);
  EXFUN (Fload, 5);
+ EXFUN (Fget_load_suffixes, 0);
  EXFUN (Fget_file_char, 0);
  EXFUN (Fread_char, 2);
  EXFUN (Fread_event, 2);
***************
*** 2614,2620 ****
  #define LOADHIST_ATTACH(x) \
   if (initialized) Vcurrent_load_list = Fcons (x, Vcurrent_load_list)
  extern Lisp_Object Vcurrent_load_list;
! extern Lisp_Object Vload_history, Vload_suffixes;
  extern int openp P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
                      Lisp_Object *, Lisp_Object));
  extern int isfloat_string P_ ((char *));
--- 2615,2621 ----
  #define LOADHIST_ATTACH(x) \
   if (initialized) Vcurrent_load_list = Fcons (x, Vcurrent_load_list)
  extern Lisp_Object Vcurrent_load_list;
! extern Lisp_Object Vload_history, Vload_suffixes, Vload_file_rep_suffixes;
  extern int openp P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
                      Lisp_Object *, Lisp_Object));
  extern int isfloat_string P_ ((char *));
============================================================

===File ~/w32.c-diff========================================
*** w32.c       06 Feb 2006 16:02:24 -0600      1.99
--- w32.c       16 Feb 2006 20:27:55 -0600      
***************
*** 3888,3894 ****
        objs[1] = decode_env_path (0, (getenv ("EMACSLOADPATH")));
        full_load_path = Fappend (2, objs);
        init_file = build_string ("term/w32-win");
!       fd = openp (full_load_path, init_file, Vload_suffixes, NULL, Qnil);
        if (fd < 0)
        {
          Lisp_Object load_path_print = Fprin1_to_string (full_load_path, Qnil);
--- 3888,3894 ----
        objs[1] = decode_env_path (0, (getenv ("EMACSLOADPATH")));
        full_load_path = Fappend (2, objs);
        init_file = build_string ("term/w32-win");
!       fd = openp (full_load_path, init_file, Fget_load_suffixes (), NULL, 
Qnil);
        if (fd < 0)
        {
          Lisp_Object load_path_print = Fprin1_to_string (full_load_path, Qnil);
============================================================

===File ~/startup.el-diff===================================
*** startup.el  21 Jan 2006 16:45:09 -0600      1.397
--- startup.el  16 Feb 2006 20:39:11 -0600      
***************
*** 646,652 ****
    (let ((lisp-dir
         (file-name-directory
          (locate-file "simple" load-path
!                      load-suffixes))))
  
      (setq load-history
          (mapcar (lambda (elt)
--- 646,652 ----
    (let ((lisp-dir
         (file-name-directory
          (locate-file "simple" load-path
!                      (get-load-suffixes)))))
  
      (setq load-history
          (mapcar (lambda (elt)
============================================================

===File ~/find-func.el-diff=================================
*** find-func.el        06 Feb 2006 16:02:02 -0600      1.68
--- find-func.el        16 Feb 2006 20:40:50 -0600      
***************
*** 142,148 ****
  
  (defun find-library-suffixes ()
    (let ((suffixes nil))
!     (dolist (suffix load-suffixes (nreverse suffixes))
        (unless (string-match "elc" suffix) (push suffix suffixes)))))
  
  (defun find-library-name (library)
--- 142,148 ----
  
  (defun find-library-suffixes ()
    (let ((suffixes nil))
!     (dolist (suffix (get-load-suffixes) (nreverse suffixes))
        (unless (string-match "elc" suffix) (push suffix suffixes)))))
  
  (defun find-library-name (library)
============================================================

===File ~/autoload.el-diff==================================
*** autoload.el 06 Feb 2006 16:02:02 -0600      1.112
--- autoload.el 16 Feb 2006 20:40:35 -0600      
***************
*** 512,518 ****
  directory or directories specified."
    (interactive "DUpdate autoloads from directory: ")
    (let* ((files-re (let ((tmp nil))
!                    (dolist (suf load-suffixes
                                  (concat "^[^=.].*" (regexp-opt tmp t) "\\'"))
                       (unless (string-match "\\.elc" suf) (push suf tmp)))))
         (files (apply 'nconc
--- 512,518 ----
  directory or directories specified."
    (interactive "DUpdate autoloads from directory: ")
    (let* ((files-re (let ((tmp nil))
!                    (dolist (suf (get-load-suffixes)
                                  (concat "^[^=.].*" (regexp-opt tmp t) "\\'"))
                       (unless (string-match "\\.elc" suf) (push suf tmp)))))
         (files (apply 'nconc
============================================================

===File ~/subr.el-diff======================================
Index: subr.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/subr.el,v
retrieving revision 1.500
diff -c -r1.500 subr.el
*** subr.el     13 Feb 2006 11:00:51 -0000      1.500
--- subr.el     19 Feb 2006 02:07:52 -0000
***************
*** 1324,1335 ****
  and the file name is displayed in the echo area."
    (interactive (list (completing-read "Locate library: "
                                      'locate-file-completion
!                                     (cons load-path load-suffixes))
                     nil nil
                     t))
    (let ((file (locate-file library
                           (or path load-path)
!                          (append (unless nosuffix load-suffixes) '("")))))
      (if interactive-call
        (if file
            (message "Library is file %s" (abbreviate-file-name file))
--- 1324,1336 ----
  and the file name is displayed in the echo area."
    (interactive (list (completing-read "Locate library: "
                                      'locate-file-completion
!                                     (cons load-path (get-load-suffixes)))
                     nil nil
                     t))
    (let ((file (locate-file library
                           (or path load-path)
!                          (append (unless nosuffix (get-load-suffixes))
!                                  load-file-rep-suffixes))))
      (if interactive-call
        (if file
            (message "Library is file %s" (abbreviate-file-name file))
============================================================

===File ~/load-hist.el-diff=================================
*** loadhist.el 06 Feb 2006 16:01:50 -0600      1.37
--- loadhist.el 16 Feb 2006 20:38:40 -0600      
***************
*** 60,67 ****
    (let ((symbols (assoc file load-history)))
      ;; Try converting a library name to an absolute file name.
      (and (null symbols)
!        (let ((absname 
!               (locate-file file load-path load-suffixes)))
           (and absname (not (equal absname file))
                (setq symbols (cdr (assoc absname load-history))))))
      symbols))
--- 60,67 ----
    (let ((symbols (assoc file load-history)))
      ;; Try converting a library name to an absolute file name.
      (and (null symbols)
!        (let ((absname
!               (locate-file file load-path (get-load-suffixes))))
           (and absname (not (equal absname file))
                (setq symbols (cdr (assoc absname load-history))))))
      symbols))
============================================================

===File ~/files.el-diff=====================================
Index: files.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/files.el,v
retrieving revision 1.813
diff -c -r1.813 files.el
*** files.el    17 Feb 2006 15:33:22 -0000      1.813
--- files.el    19 Feb 2006 02:03:41 -0000
***************
*** 698,704 ****
    (interactive
     (list (completing-read "Load library: "
                          'locate-file-completion
!                         (cons load-path load-suffixes))))
    (load library))
  
  (defun file-remote-p (file)
--- 698,704 ----
    (interactive
     (list (completing-read "Load library: "
                          'locate-file-completion
!                         (cons load-path (get-load-suffixes)))))
    (load library))
  
  (defun file-remote-p (file)
============================================================

===File ~/jka-compr.el-diff=================================
Index: jka-compr.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/jka-compr.el,v
retrieving revision 1.89
diff -c -r1.89 jka-compr.el
*** jka-compr.el        6 Feb 2006 14:33:34 -0000       1.89
--- jka-compr.el        19 Feb 2006 02:05:27 -0000
***************
*** 662,674 ****
  by `jka-compr-installed'."
    ;; Delete from inhibit-first-line-modes-suffixes
    ;; what jka-compr-install added.
!   (mapcar
       (function (lambda (x)
                 (and (jka-compr-info-strip-extension x)
                      (setq inhibit-first-line-modes-suffixes
                            (delete (jka-compr-info-regexp x)
                                    inhibit-first-line-modes-suffixes)))))
!      jka-compr-compression-info-list)
  
    (let* ((fnha (cons nil file-name-handler-alist))
         (last fnha))
--- 662,674 ----
  by `jka-compr-installed'."
    ;; Delete from inhibit-first-line-modes-suffixes
    ;; what jka-compr-install added.
!   (mapc
       (function (lambda (x)
                 (and (jka-compr-info-strip-extension x)
                      (setq inhibit-first-line-modes-suffixes
                            (delete (jka-compr-info-regexp x)
                                    inhibit-first-line-modes-suffixes)))))
!      jka-compr-compression-info-list--internal)
  
    (let* ((fnha (cons nil file-name-handler-alist))
         (last fnha))
***************
*** 686,692 ****
  
      (while (cdr last)
        (setq entry (car (cdr last)))
!       (if (or (member entry jka-compr-mode-alist-additions)
              (and (consp (cdr entry))
                   (eq (nth 2 entry) 'jka-compr)))
          (setcdr last (cdr (cdr last)))
--- 686,692 ----
  
      (while (cdr last)
        (setq entry (car (cdr last)))
!       (if (or (member entry jka-compr-mode-alist-additions--internal)
              (and (consp (cdr entry))
                   (eq (nth 2 entry) 'jka-compr)))
          (setcdr last (cdr (cdr last)))
***************
*** 701,712 ****
                  file-coding-system-alist)))
  
    ;; 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))))
  
  (provide 'jka-compr)
  
--- 701,712 ----
                  file-coding-system-alist)))
  
    ;; Remove the suffixes that were added by jka-compr.
!   (dolist (suff jka-compr-load-suffixes--internal)
!     (setq load-file-rep-suffixes (delete suff load-file-rep-suffixes)))
! 
!   (setq jka-compr-compression-info-list--internal nil
!       jka-compr-mode-alist-additions--internal nil
!       jka-compr-load-suffixes--internal nil))
  
  (provide 'jka-compr)
  
============================================================

===File ~/jka-cmpr-hook.el-diff=============================
Index: jka-cmpr-hook.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/jka-cmpr-hook.el,v
retrieving revision 1.9
diff -c -r1.9 jka-cmpr-hook.el
*** jka-cmpr-hook.el    6 Feb 2006 14:33:34 -0000       1.9
--- jka-cmpr-hook.el    19 Feb 2006 02:04:15 -0000
***************
*** 26,32 ****
  
  ;;; Commentary:
  
! ;; This file contains the  code to enable and disable Auto-Compression mode.
  ;; It is preloaded.  The guts of this mode are in jka-compr.el, which
  ;; is loaded only when you really try to uncompress something.
  
--- 26,32 ----
  
  ;;; Commentary:
  
! ;; This file contains the code to enable and disable Auto-Compression mode.
  ;; It is preloaded.  The guts of this mode are in jka-compr.el, which
  ;; is loaded only when you really try to uncompress something.
  
***************
*** 40,45 ****
--- 40,182 ----
    "jka-compr customization."
    :group 'compression)
  
+ ;; 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
+   "`file-name-handler-alist' entry used by jka-compr I/O functions.")
+ 
+ ;; Compiler defvars.  These three variables will be defined later with
+ ;; `defcustom' when everything used in the :set functions is defined.
+ (defvar jka-compr-compression-info-list)
+ (defvar jka-compr-mode-alist-additions)
+ (defvar jka-compr-load-suffixes)
+ 
+ (defvar jka-compr-compression-info-list--internal nil
+   "Stored value of `jka-compr-compression-info-list'.
+ If jka-compr is installed, this is the value of
+ `jka-compr-compression-info-list' when `jka-compr-install' was last called.
+ Otherwise, it is nil.")
+ 
+ (defvar jka-compr-mode-alist-additions--internal nil
+   "Stored value of `jka-compr-mode-alist-additions'.
+ If jka-compr is installed, this is the value of
+ `jka-compr-mode-alist-additions' when `jka-compr-install' was last called.
+ Otherwise, it is nil.")
+ 
+ (defvar jka-compr-load-suffixes--internal nil
+   "Stored value of `jka-compr-load-suffixes'.
+ If jka-compr is installed, this is the value of
+ `jka-compr-load-suffixes' when `jka-compr-install' was last called.
+ Otherwise, it is nil.")
+ 
+ 
+ (defun jka-compr-build-file-regexp ()
+   (mapconcat
+    'jka-compr-info-regexp
+    jka-compr-compression-info-list
+    "\\|"))
+ 
+ ;; Functions for accessing the return value of jka-compr-get-compression-info
+ (defun jka-compr-info-regexp               (info)  (aref info 0))
+ (defun jka-compr-info-compress-message     (info)  (aref info 1))
+ (defun jka-compr-info-compress-program     (info)  (aref info 2))
+ (defun jka-compr-info-compress-args        (info)  (aref info 3))
+ (defun jka-compr-info-uncompress-message   (info)  (aref info 4))
+ (defun jka-compr-info-uncompress-program   (info)  (aref info 5))
+ (defun jka-compr-info-uncompress-args      (info)  (aref info 6))
+ (defun jka-compr-info-can-append           (info)  (aref info 7))
+ (defun jka-compr-info-strip-extension      (info)  (aref info 8))
+ (defun jka-compr-info-file-magic-bytes     (info)  (aref info 9))
+ 
+ 
+ (defun jka-compr-get-compression-info (filename)
+   "Return information about the compression scheme of FILENAME.
+ The determination as to which compression scheme, if any, to use is
+ based on the filename itself and `jka-compr-compression-info-list'."
+   (catch 'compression-info
+     (let ((case-fold-search nil))
+       (mapcar
+        (function (lambda (x)
+                  (and (string-match (jka-compr-info-regexp x) filename)
+                       (throw 'compression-info x))))
+        jka-compr-compression-info-list)
+       nil)))
+ 
+ (defun jka-compr-install ()
+   "Install jka-compr.
+ This adds entries to `file-name-handler-alist' and `auto-mode-alist'
+ and `inhibit-first-line-modes-suffixes'."
+ 
+   (setq jka-compr-file-name-handler-entry
+       (cons (jka-compr-build-file-regexp) 'jka-compr-handler))
+ 
+   (push jka-compr-file-name-handler-entry file-name-handler-alist)
+ 
+   (setq jka-compr-compression-info-list--internal
+       jka-compr-compression-info-list
+       jka-compr-mode-alist-additions--internal
+       jka-compr-mode-alist-additions
+       jka-compr-load-suffixes--internal
+       jka-compr-load-suffixes)
+ 
+   (dolist (x jka-compr-compression-info-list)
+     ;; Don't do multibyte encoding on the compressed files.
+     (let ((elt (cons (jka-compr-info-regexp x)
+                      '(no-conversion . no-conversion))))
+       (push elt file-coding-system-alist)
+       (push 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
+          ;; sans `.gz'.
+          (push (list (jka-compr-info-regexp x) nil 'jka-compr) 
auto-mode-alist)
+          ;; Also add these regexps to
+          ;; inhibit-first-line-modes-suffixes, so that a
+          ;; -*- line in the first file of a compressed tar
+          ;; file doesn't override tar-mode.
+          (push (jka-compr-info-regexp x)
+                inhibit-first-line-modes-suffixes)))
+   (setq auto-mode-alist
+       (append auto-mode-alist jka-compr-mode-alist-additions))
+ 
+   ;; Make sure that (load "foo") will find /bla/foo.el.gz.
+   (setq load-file-rep-suffixes
+       (append load-file-rep-suffixes jka-compr-load-suffixes nil)))
+ 
+ (defun jka-compr-installed-p ()
+   "Return non-nil if jka-compr is installed.
+ The return value is the entry in `file-name-handler-alist' for jka-compr."
+ 
+   (let ((fnha file-name-handler-alist)
+       (installed nil))
+ 
+     (while (and fnha (not installed))
+      (and (eq (cdr (car fnha)) 'jka-compr-handler)
+          (setq installed (car fnha)))
+       (setq fnha (cdr fnha)))
+ 
+     installed))
+ 
+ (defun jka-compr-update ()
+   "Update Auto Compression mode for changes in option values.
+ If you change the options `jka-compr-compression-info-list',
+ `jka-compr-mode-alist-additions' or `jka-compr-load-suffixes'
+ outside Custom, while Auto Compression mode is already enabled
+ \(as it is by default), then you have to call this function
+ afterward to properly update other variables.  Setting these
+ options through Custom does this automatically."
+   (when (jka-compr-installed-p)
+     (jka-compr-uninstall)
+     (jka-compr-install)))
+ 
+ (defun jka-compr-set (variable value)
+   "Internal Custom :set function."
+   (set-default variable value)
+   (jka-compr-update))
+ 
  ;; I have this defined so that .Z files are assumed to be in unix
  ;; compress format; and .gz files, in gzip format, and .bz2 files in bzip fmt.
  (defcustom jka-compr-compression-info-list
***************
*** 113,119 ****
  
  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."
    :type '(repeat (vector regexp
                         (choice :tag "Compress Message"
                                 (string :format "%v")
--- 250,261 ----
  
  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.
! 
! If you set this outside Custom while Auto Compression mode is already enabled
! \(as it is by default), you have to call `jka-compr-update' after setting it
! to properly update other variables.  Setting this through Custom does that
! automatically."
    :type '(repeat (vector regexp
                         (choice :tag "Compress Message"
                                 (string :format "%v")
***************
*** 132,249 ****
                         (boolean :tag "Append")
                         (boolean :tag "Strip Extension")
                         (string :tag "Magic Bytes")))
    :group 'jka-compr)
  
  (defcustom jka-compr-mode-alist-additions
    (list (cons "\\.tgz\\'" 'tar-mode) (cons "\\.tbz\\'" 'tar-mode))
!   "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)
- 
- (defvar jka-compr-file-name-handler-entry
-   nil
-   "The entry in `file-name-handler-alist' used by the jka-compr I/O 
functions.")
- 
- (defun jka-compr-build-file-regexp ()
-   (mapconcat
-    'jka-compr-info-regexp
-    jka-compr-compression-info-list
-    "\\|"))
- 
- ;; Functions for accessing the return value of jka-compr-get-compression-info
- (defun jka-compr-info-regexp               (info)  (aref info 0))
- (defun jka-compr-info-compress-message     (info)  (aref info 1))
- (defun jka-compr-info-compress-program     (info)  (aref info 2))
- (defun jka-compr-info-compress-args        (info)  (aref info 3))
- (defun jka-compr-info-uncompress-message   (info)  (aref info 4))
- (defun jka-compr-info-uncompress-program   (info)  (aref info 5))
- (defun jka-compr-info-uncompress-args      (info)  (aref info 6))
- (defun jka-compr-info-can-append           (info)  (aref info 7))
- (defun jka-compr-info-strip-extension      (info)  (aref info 8))
- (defun jka-compr-info-file-magic-bytes     (info)  (aref info 9))
- 
- 
- (defun jka-compr-get-compression-info (filename)
-   "Return information about the compression scheme of FILENAME.
- The determination as to which compression scheme, if any, to use is
- based on the filename itself and `jka-compr-compression-info-list'."
-   (catch 'compression-info
-     (let ((case-fold-search nil))
-       (mapcar
-        (function (lambda (x)
-                  (and (string-match (jka-compr-info-regexp x) filename)
-                       (throw 'compression-info x))))
-        jka-compr-compression-info-list)
-       nil)))
- 
- (defun jka-compr-install ()
-   "Install jka-compr.
- This adds entries to `file-name-handler-alist' and `auto-mode-alist'
- and `inhibit-first-line-modes-suffixes'."
- 
-   (setq jka-compr-file-name-handler-entry
-       (cons (jka-compr-build-file-regexp) 'jka-compr-handler))
- 
-   (push jka-compr-file-name-handler-entry file-name-handler-alist)
- 
-   (dolist (x jka-compr-compression-info-list)
-     ;; Don't do multibyte encoding on the compressed files.
-     (let ((elt (cons (jka-compr-info-regexp x)
-                      '(no-conversion . no-conversion))))
-       (push elt file-coding-system-alist)
-       (push 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
-          ;; sans `.gz'.
-          (push (list (jka-compr-info-regexp x) nil 'jka-compr) 
auto-mode-alist)
-          ;; Also add these regexps to
-          ;; inhibit-first-line-modes-suffixes, so that a
-          ;; -*- line in the first file of a compressed tar
-          ;; file doesn't override tar-mode.
-          (push (jka-compr-info-regexp x)
-                inhibit-first-line-modes-suffixes)))
-   (setq auto-mode-alist
-       (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
-              (append (mapcar (lambda (suffix)
-                                (cons suffix
-                                      (mapcar (lambda (ext) (concat suffix 
ext))
-                                              jka-compr-load-suffixes)))
-                              load-suffixes)
-                        (list jka-compr-load-suffixes)))))
- 
- 
- (defun jka-compr-installed-p ()
-   "Return non-nil if jka-compr is installed.
- The return value is the entry in `file-name-handler-alist' for jka-compr."
- 
-   (let ((fnha file-name-handler-alist)
-       (installed nil))
- 
-     (while (and fnha (not installed))
-      (and (eq (cdr (car fnha)) 'jka-compr-handler)
-          (setq installed (car fnha)))
-       (setq fnha (cdr fnha)))
- 
-     installed))
- 
  (define-minor-mode auto-compression-mode
    "Toggle automatic file compression and uncompression.
  With prefix argument ARG, turn auto compression on if positive, else off.
! Returns the new status of auto compression (non-nil means on)."
    :global t :init-value t :group 'jka-compr :version "22.1"
    (let* ((installed (jka-compr-installed-p))
         (flag auto-compression-mode))
--- 274,314 ----
                         (boolean :tag "Append")
                         (boolean :tag "Strip Extension")
                         (string :tag "Magic Bytes")))
+   :set 'jka-compr-set
    :group 'jka-compr)
  
  (defcustom jka-compr-mode-alist-additions
    (list (cons "\\.tgz\\'" 'tar-mode) (cons "\\.tbz\\'" 'tar-mode))
!   "List of pairs added to `auto-mode-alist' when installing jka-compr.
! Uninstalling jka-compr removes all pairs from `auto-mode-alist' that
! installing added.
! 
! If you set this outside Custom while Auto Compression mode is already enabled
! \(as it is by default), you have to call `jka-compr-update' after setting it
! to properly update other variables.  Setting this through Custom does that
! automatically."
    :type '(repeat (cons string symbol))
+   :set 'jka-compr-set
    :group 'jka-compr)
  
  (defcustom jka-compr-load-suffixes '(".gz")
!   "List of compression related suffixes to try when loading files.
! Enabling Auto Compression mode appends this list to `load-file-rep-suffixes',
! which see.  Disabling Auto Compression mode removes all suffixes
! from `load-file-rep-suffixes' that enabling added.
! 
! If you set this outside Custom while Auto Compression mode is already enabled
! \(as it is by default), you have to call `jka-compr-update' after setting it
! to properly update other variables.  Setting this through Custom does that
! automatically."
    :type '(repeat string)
+   :set 'jka-compr-set
    :group 'jka-compr)
  
  (define-minor-mode auto-compression-mode
    "Toggle automatic file compression and uncompression.
  With prefix argument ARG, turn auto compression on if positive, else off.
! Return the new status of auto compression (non-nil means on)."
    :global t :init-value t :group 'jka-compr :version "22.1"
    (let* ((installed (jka-compr-installed-p))
         (flag auto-compression-mode))
============================================================




reply via email to

[Prev in Thread] Current Thread [Next in Thread]