home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / gnu / lucid / help-lucid-emacs / text0129.txt < prev    next >
Encoding:
Text File  |  1993-07-14  |  27.4 KB  |  817 lines
  1. Hi Jay,
  2.  
  3.    I'm using your latest version of jka-compr.el with Lucid Emacs 19.6. I've
  4. had to make a modification to what you describe for it to work with the version
  5. of dired supplied with Lucid Emacs 19.6. Instead of dired-byte-recompile, it
  6. uses dired-byte-compile which I've modified as follows. I enclose jka-compr.el
  7. below.
  8.  
  9. ;; Modify this in dired.el to allow "B" to bytecompile .el, .elz and .elZ files
  10. (defun dired-byte-compile ()
  11.   ;; Return nil for success, offending file name else.
  12.   (let* ((filename (dired-get-filename))
  13.      (elc-file
  14.       (if (eq system-type 'vax-vms)
  15.           (concat (substring filename 0 (string-match ";" filename)) "c")
  16.             (if (string-match "\\.el\\(\\.[zZ]\\)?$" filename)
  17.                 (concat (substring filename 0 (match-beginning 0)) ".elc")
  18.         (error "%s is uncompilable!" filename))))
  19.      buffer-read-only failure)
  20.     (condition-case err
  21.     (save-excursion (byte-compile-file filename))
  22.       (error
  23.        (setq failure err)))
  24.     (if failure
  25.     (progn
  26.       (dired-log "Byte compile error for %s:\n%s\n" filename failure)
  27.       (dired-make-relative filename))
  28.       (dired-remove-file elc-file)
  29.       (forward-line)            ; insert .elc after its .el file
  30.       (dired-add-file elc-file)
  31.       nil)))
  32.  
  33. --
  34. Regards, David
  35.  
  36. 8< ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ CUT HERE for file: jka-compr.el
  37. ;;; jka-compr.el - low level support for reading/writing compressed files
  38. ;;; bugs/comments to jka@ece.cmu.edu
  39. ;;; 4/19/93a version + mod by David Hughes 20th April 1993
  40.  
  41.  
  42. ;;; Copyright (C) 1993  Jay K. Adams
  43. ;;;
  44. ;;; This program is free software; you can redistribute it and/or modify
  45. ;;; it under the terms of the GNU General Public License as published by
  46. ;;; the Free Software Foundation; either version 2 of the License, or
  47. ;;; (at your option) any later version.
  48. ;;;
  49. ;;; This program is distributed in the hope that it will be useful,
  50. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  51. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  52. ;;; GNU General Public License for more details.
  53. ;;;
  54. ;;; You should have received a copy of the GNU General Public License
  55. ;;; along with this program; if not, write to the Free Software
  56. ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  57.  
  58.  
  59. ;;; LCD Archive Entry:
  60. ;;; jka-compr|Jay Adams|jka@ece.cmu.edu|
  61. ;;; Low level support for reading/writing compressed files|
  62. ;;; 1993-03-02||~/misc/jka-compr.el.Z|
  63.  
  64.  
  65. ;;; This package implements low-level support for reading and writing
  66. ;;; compressed files.  It overwrites several low-level file I/O
  67. ;;; functions (including write-region and insert-file-contents) so
  68. ;;; that they automatically compress or uncompress a file if the file
  69. ;;; appears to need it (based on the extension of the file name).
  70. ;;; Although its a little presumptious of a low-level function to make
  71. ;;; a decision about whether a file should be compressed or
  72. ;;; uncompressed, doing so offers the benefit of allowing packages
  73. ;;; like Rmail, Vm, Gnus, and Info to work with compressed files
  74. ;;; without modification.
  75.  
  76.  
  77. ;;; INSTRUCTIONS:
  78. ;;;
  79. ;;; To use jka-compr, simply load this package, and edit as usual.
  80. ;;; Its operation should be transparent to the user (except for
  81. ;;; messages appearing when a file is being compressed or
  82. ;;; uncompressed).
  83. ;;;
  84. ;;; *** THIS PACKAGE SHOULD BE LOADED BEFORE ANGE-FTP ***
  85. ;;;
  86. ;;; The variable, jka-compr-compression-info-list can be used to
  87. ;;; customize jka-compr to work with other compression programs.  The
  88. ;;; default value of this variable allows jka-compr to work with Unix
  89. ;;; compress and gzip.
  90. ;;; 
  91. ;;; If you are concerned about the stderr output of gzip and other
  92. ;;; compression/decompression programs showing up in your buffers you
  93. ;;; should set the discard-error flag in the compression-info-list.
  94. ;;; This will cause the stderr of all programs to be discarded.
  95. ;;; However, it also causes emacs to call compression/uncompression
  96. ;;; programs through a shell (which is specified by jka-compr-shell).
  97. ;;; This may be a drag if, on your system, starting up a shell is
  98. ;;; slow.
  99. ;;;
  100. ;;; If you don't want messages about compressing and decompressing
  101. ;;; to show up in the echo area, you can set the compress-name and
  102. ;;; decompress-name fields of the jka-compr-compression-info-list to
  103. ;;; nil.
  104.  
  105.  
  106. ;;; APPLICATION NOTES:
  107. ;;; 
  108. ;;; loading compressed elisp files
  109. ;;;   The jka-load package gives you the ability to load, autoload,
  110. ;;;   and require compressed elisp files when jka-compr is installed.
  111. ;;;   jka-load is probably available wherever you got jka-compr.
  112. ;;;
  113. ;;; dired
  114. ;;;   Normally jka-compr works fine with dired.  However, one case
  115. ;;;   where it doesn't work so well is when you use the dired 'B'
  116. ;;;   command (byte compile file).  The .z on the file name makes
  117. ;;;   dired think the file is not compilable.  Changing the
  118. ;;;   dired-byte-compile function to the one shown below will get
  119. ;;;   around this problem.  It makes dired recognize a file as being
  120. ;;;   an emacs lisp file even if it has a .z or .Z extension after the
  121. ;;;   .el. 
  122. ;;;
  123. ;;;   (defun dired-byte-recompile ()
  124. ;;;     "Byte recompile this file."
  125. ;;;     (interactive)
  126. ;;;     (let* ((buffer-read-only nil)
  127. ;;;            (from-file (dired-get-filename))
  128. ;;;            (to-file (substring from-file 0 -3)))
  129. ;;;       (if (string-match "\\.el\\(\\.[zZ]\\)?$" from-file) nil
  130. ;;;           (error "%s is uncompilable!" from-file))
  131. ;;;       (byte-compile-file from-file)))
  132. ;;;
  133. ;;;       (David Hughes 20th April 1993) : use this for Lucid Emacs 19.6
  134. ;;;       
  135. ;;;  (defun dired-byte-compile ()
  136. ;;;    ;; Return nil for success, offending file name else.
  137. ;;;    (let* ((filename (dired-get-filename))
  138. ;;;       (elc-file
  139. ;;;        (if (eq system-type 'vax-vms)
  140. ;;;            (concat (substring filename 0
  141. ;;;                                   (string-match ";" filename)) "c")
  142. ;;;              (if (string-match "\\.el\\(\\.[zZ]\\)?$" filename)
  143. ;;;                  (concat (substring filename 0
  144. ;;;                                     (match-beginning 0)) ".elc")
  145. ;;;          (error "%s is uncompilable!" filename))))
  146. ;;;       buffer-read-only failure)
  147. ;;;      (condition-case err
  148. ;;;      (save-excursion (byte-compile-file filename))
  149. ;;;        (error
  150. ;;;         (setq failure err)))
  151. ;;;      (if failure
  152. ;;;      (progn
  153. ;;;        (dired-log "Byte compile error for %s:\n%s\n"
  154. ;;;                       filename failure)
  155. ;;;        (dired-make-relative filename))
  156. ;;;        (dired-remove-file elc-file)
  157. ;;;      (forward-line)       ; insert .elc after its .el file
  158. ;;;      (dired-add-file elc-file)
  159. ;;;      nil)))
  160. ;;;
  161. ;;;
  162. ;;; rmail, vm, gnus, etc.
  163. ;;;   To use compressed mail folders, .newsrc files, etc., you need
  164. ;;;   only compress the file.  Since jka-compr searches for .z
  165. ;;;   versions of the files it's finding, you need not change
  166. ;;;   variables within rmail, gnus, etc.  
  167. ;;;
  168. ;;; crypt++
  169. ;;;   jka-compr can coexist with crpyt++ if you take all the decryption
  170. ;;;   entries out of the crypt-encoding-list.  Clearly problems will
  171. ;;;   arise if you have two programs trying to compress/decompress
  172. ;;;   files.  jka-compr will not "work with" crypt++: you won't be
  173. ;;;   able to decode encrypted compressed files--that is, files that
  174. ;;;   have been compressed then encrypted (in that order).
  175. ;;;   Theoretically, crypt++ and jka-compr could properly handle a
  176. ;;;   file that has been encrypted then compressed, but there is little
  177. ;;;   point in trying to compress an encrypted file.
  178.  
  179.  
  180.  
  181. ;;; TO DO
  182. ;;;
  183. ;;; Note:  as far as I'm concerned, the whole idea of dealing with
  184. ;;; compressed files in this way is still experimental.  Still, I and
  185. ;;; others have been using this code for some time and have found it
  186. ;;; useful.
  187. ;;;
  188. ;;; Also, I consider this code to be in beta-test.  The bug rate has
  189. ;;; been pretty low, however, so after the few remaining issues
  190. ;;; (listed below) are addressed, I'll release Version 1.0 (maybe
  191. ;;; sometime this summer).
  192. ;;;
  193. ;;; To do list:
  194. ;;;
  195. ;;; 1. Make jka-compr work whether or not ange-ftp is loaded first.
  196. ;;;    I'm not sure if this is practical.  Forcing jka-compr to be
  197. ;;;    loaded first seems like a good compromise for now.
  198. ;;;
  199. ;;; 2. Fix it so that the compression extension (.Z or .z) does not
  200. ;;;    appear in the buffer name.
  201. ;;;
  202. ;;; 3. Add the ability to configure translations on the file name to
  203. ;;;    be applied before mode-specification.  For instance, .taz files
  204. ;;;    should be recognized as being compressed but should be treated
  205. ;;;    as .tar files for mode-specification.
  206. ;;;
  207. ;;; 4. Consider making file name completion less concerned with .Z suffixes.
  208. ;;; 
  209. ;;; 5. Figure out how to do error checking and handling.
  210. ;;;    Unfortunately, there doesn't seem to be any way to check the
  211. ;;;    error status of programs called by emacs through call-process.
  212. ;;;
  213. ;;; 6. Encrypted files.  It would be nice to be able to handle
  214. ;;;    encrypted compressed files.
  215.  
  216.  
  217.  
  218. (defvar jka-compr-enabled t
  219.   "*Non-nil means that the jka-compr package is enabled.")
  220.  
  221.  
  222. (defvar jka-compr-verify-append-file-change t
  223.   "Non-nil means ask the user before changing the name of an append file.")
  224.  
  225.  
  226. (defvar jka-compr-verify-overwrite-file-change t
  227.   "Non-nil means ask the user before changing the name of a file being written.")
  228.  
  229.  
  230. (defvar jka-compr-verify-visited-file-change t
  231.   "Non-nil means ask the user before changing the visited file name of a buffer.")
  232.  
  233.  
  234. (defvar jka-compr-verify-delete-file-change t
  235.   "Non-nil means ask the user before changing the name of a file being deleted.")
  236.  
  237.  
  238. (defvar jka-compr-shell "sh"
  239.   "*Shell to be used for calling compression programs.
  240. The value of this variable only matters if you want to discard the
  241. stderr of a compression/decompression program (see the documentation
  242. for jka-compr-compression-info-list).")
  243.  
  244.  
  245. ;;; I have this defined so that .Z files are assumed to be in unix
  246. ;;; compress format; and .z files, in gzip format.
  247. (defvar jka-compr-compression-info-list
  248.   ;;[regexp  magic 
  249.   ;; compr-name  compr-prog  compr-discard  compr-args
  250.   ;; uncomp-name uncomp-prog uncomp-discard uncomp-args
  251.   ;; can-append extension]
  252.   '(["\\.Z~?$"     "\037\235"
  253.      "compress"    "compress"     nil  nil
  254.      "uncompress"  "uncompress"   nil  nil
  255.      nil           ".Z"]
  256.     ["\\.z~?$"     "\037\213"
  257.      "zip"         "gzip"         nil  nil
  258.      "unzip"       "gzip"         nil  ("-d")
  259.      t             ".z"])
  260.  
  261.   "List of vectors that describe available compression techniques.
  262. Each element, which describes a compression technique, is a vector of
  263. the form [regexp magic compress-name compress-program compress-discard-err
  264. compress-args uncompress-name uncompress-program uncompress-discard-err
  265. uncompress-args append-flag extension] where:
  266.  
  267.    regexp                is a regexp that matches filenames that are
  268.                          compressed with this format
  269.  
  270.    magic                 is a two-byte magic number that identifies
  271.                          files that are compressed with this format
  272.  
  273.    compress-name         is an English name of the compression (nil
  274.                          means don't show message when compressing)
  275.  
  276.    compress-program      is a program that performs this compression
  277.  
  278.    compress-discard-err  is non-nil if the stderr output of the compress
  279.                          program should be discarded.  Setting this flag to 
  280.                          non-nil also causes jka-compr to call compression
  281.                          programs using a shell rather than directly.
  282.  
  283.    compress-args         is a list of args to pass to the compress program
  284.  
  285.    uncompress-name       is an English name of the uncompression (nil
  286.                          means don't show message when decompressing)
  287.  
  288.    uncompress-program    is a program that performs this compression
  289.  
  290.    uncompress-discard-err  is non-nil if the stderr output of the uncompress
  291.                          program should be discarded.  Setting this flag to 
  292.                          non-nil also causes jka-compr to call decompression
  293.                          programs using a shell rather than directly.
  294.  
  295.    uncompress-args       is a list of args to pass to the uncompress program
  296.  
  297.    append-flag           is non-nil if this compression technique can be
  298.                          appended
  299.  
  300.    extension             string to add to end of filename when looking for
  301.                          files compressed with this technique.
  302.  
  303. Because of the way call-process is defined, discarding the stderr output of
  304. a program adds the overhead of starting a shell each time the program is
  305. invoked.")
  306.  
  307.  
  308. ;;; Functions for accessing the return value of jka-get-compression-info
  309. (defun jka-compr-info-fname-match-beg      (info)  (car (car info)))
  310. (defun jka-compr-info-fname-match-end      (info)  (cdr (car info)))
  311. (defun jka-compr-info-fname-regexp         (info)  (aref (cdr info) 0))
  312. (defun jka-compr-info-magic                (info)  (aref (cdr info) 1))
  313. (defun jka-compr-info-compress-message     (info)  (aref (cdr info) 2))
  314. (defun jka-compr-info-compress-program     (info)  (aref (cdr info) 3))
  315. (defun jka-compr-info-compress-discard-err (info)  (aref (cdr info) 4))
  316. (defun jka-compr-info-compress-args        (info)  (aref (cdr info) 5))
  317. (defun jka-compr-info-uncompress-message   (info)  (aref (cdr info) 6))
  318. (defun jka-compr-info-uncompress-program   (info)  (aref (cdr info) 7))
  319. (defun jka-compr-info-uncompress-discard-err (info)  (aref (cdr info) 8))
  320. (defun jka-compr-info-uncompress-args      (info)  (aref (cdr info) 9))
  321. (defun jka-compr-info-can-append           (info)  (aref (cdr info) 10))
  322.  
  323.  
  324. (defun jka-compr-get-compression-info-mapper (x)
  325.   "Function used by jka-compr-get-compression-info
  326. to map across the jka-compr-compression-info-list."
  327.   (let ((case-fold-search nil))
  328.     (if (string-match (aref x 0) filename)
  329.     (throw 'compression-info
  330.            (cons (cons (match-beginning 0) (match-end 0))
  331.              x)))))
  332.  
  333.  
  334. (defvar jka-compr-mktemp-regexp 
  335.   "[A-Za-z0-9][A-Za-z0-9][A-Za-z0-9][A-Za-z0-9][A-Za-z0-9][A-Za-z0-9]"
  336.   "A regexp that matches the return value of mktemp(3).")
  337.  
  338.  
  339. (defun jka-compr-get-compression-info (filename)
  340.   "Return information about the compression scheme of FILENAME.
  341. The determination as to which compression scheme, if any, to use is
  342. based on the filename itself and jka-compr-compression-info-list."
  343.   (and
  344.    (boundp 'ange-ftp-tmp-name-template)
  345.    (boundp 'path)
  346.    (or
  347.     ;; See if it looks like an ange-ftp temp file.
  348.     (string-match (concat "^" (regexp-quote ange-ftp-tmp-name-template)
  349.               jka-compr-mktemp-regexp "$")
  350.           filename)
  351.     (string-match (concat "^" (regexp-quote ange-ftp-gateway-tmp-name-template)
  352.               jka-compr-mktemp-regexp "$")
  353.           filename))
  354.    ;; If so, use the path variable (dynamically bound by
  355.    ;; ange-ftp-insert-file-contents and ange-ftp-write-region) as the file
  356.    ;; name.
  357.    (setq filename path))
  358.  
  359.   (catch 'compression-info
  360.     (mapcar 'jka-compr-get-compression-info-mapper
  361.         jka-compr-compression-info-list)
  362.     nil))
  363.  
  364.  
  365.  
  366. (defvar jka-compr-temp-name-template
  367.   "/usr/tmp/jka-compr")
  368.  
  369.  
  370. (defun jka-compr-write-region (start end filename &optional append visit)
  371.   "Documented as original."
  372.   (interactive "r\nFWrite region to file: ")
  373.   (cond
  374.    (jka-compr-enabled
  375.     (let (zfile)
  376.       (setq filename (expand-file-name filename))
  377.       (setq zfile (or (jka-compr-find-compressed-version filename)
  378.               filename))
  379.       (or
  380.        (string= zfile filename)
  381.        (if append
  382.  
  383.        (and
  384.         (or (not jka-compr-verify-append-file-change)
  385.         (yes-or-no-p (format "Append to file %s? " zfile)))
  386.         (setq filename zfile))
  387.  
  388.      (and
  389.       (or (not jka-compr-verify-overwrite-file-change)
  390.           (yes-or-no-p (format "Overwrite file %s? " zfile)))
  391.       (setq filename zfile)))))
  392.  
  393.     (let ((info (jka-compr-get-compression-info filename)))
  394.  
  395.       (if info
  396.  
  397.       (let ((can-append (jka-compr-info-can-append info))
  398.         (compress-program (jka-compr-info-compress-program info))
  399.         (compress-message (jka-compr-info-compress-message info))
  400.         (uncompress-program (jka-compr-info-uncompress-program info))
  401.         (uncompress-message (jka-compr-info-uncompress-message info))
  402.         (compress-args (jka-compr-info-compress-args info))
  403.         (uncompress-args (jka-compr-info-uncompress-args info))
  404.         (discard-err (jka-compr-info-compress-discard-err info))
  405.         (temp-file (make-temp-name jka-compr-temp-name-template))
  406.         cbuf temp-buffer)
  407.  
  408.         (or
  409.          discard-err
  410.          (progn
  411.            (setq cbuf (current-buffer)
  412.              temp-buffer (get-buffer-create " *jka-compr-temp*"))
  413.            (set-buffer temp-buffer)
  414.            (widen) (erase-buffer)
  415.            (set-buffer cbuf)))
  416.  
  417.         (and append
  418.          (not can-append)
  419.          (jka-compr-real-file-exists-p filename)
  420.          (progn
  421.               
  422.            (and
  423.             uncompress-message
  424.             (message "%sing %s..." uncompress-message
  425.                  (file-name-nondirectory filename)))
  426.  
  427.            (if discard-err
  428.  
  429.                (call-process
  430.             jka-compr-shell filename nil nil
  431.             "-c" (format "%s -c %s 2> /dev/null > %s"
  432.                      uncompress-program
  433.                      (mapconcat (function (lambda (x) x))
  434.                         uncompress-args
  435.                         " ")
  436.                      temp-file))
  437.                
  438.              (apply 'call-process
  439.                 uncompress-program filename temp-buffer nil
  440.                 uncompress-args)
  441.              (set-buffer temp-buffer)
  442.              (jka-compr-real-write-region (point-min) (point-max)
  443.                           temp-file)
  444.              (erase-buffer)
  445.              (set-buffer cbuf))
  446.  
  447.            (and
  448.             uncompress-message
  449.             (message "%sing %s...done" uncompress-message
  450.                  (file-name-nondirectory filename)))))
  451.  
  452.         (and 
  453.          compress-message
  454.          (message "%sing %s..." compress-message
  455.               (file-name-nondirectory filename)))
  456.  
  457.         (jka-compr-real-write-region start end temp-file t 'dont)
  458.  
  459.         (if discard-err
  460.  
  461.         ;; this seems a little dangerous
  462.         (call-process
  463.          jka-compr-shell temp-file nil nil
  464.          "-c" (format "%s -c %s 2> /dev/null %s %s"
  465.                   compress-program
  466.                   (mapconcat (function (lambda (x) x))
  467.                      compress-args " ")
  468.                   (if (and append can-append) ">>" ">")
  469.                   filename))
  470.  
  471.           (apply 'call-process
  472.              compress-program temp-file temp-buffer nil
  473.              compress-args)
  474.           (set-buffer temp-buffer)
  475.           (jka-compr-real-write-region (point-min) (point-max)
  476.                        filename (and append can-append))
  477.           (erase-buffer)
  478.           (set-buffer cbuf))
  479.  
  480.         (jka-compr-real-delete-file temp-file)
  481.  
  482.         (and
  483.          compress-message
  484.          (message "%sing %s...done" compress-message
  485.               (file-name-nondirectory filename)))
  486.  
  487.         (and
  488.          (eq visit t)
  489.          (progn
  490.            ;; set visited file name and buffer file modtime
  491.            (clear-visited-file-modtime)
  492.            (jka-compr-real-write-region start start filename t t)))
  493.  
  494.         (if (and visit (not (eq visit t)))
  495.         nil
  496.           (message "Wrote %s" filename)
  497.           nil))
  498.           
  499.     (jka-compr-real-write-region start end filename append visit))))
  500.    (t
  501.     (jka-compr-real-write-region start end filename append visit))))
  502.     
  503.  
  504.  
  505. (defun jka-compr-insert-file-contents (filename &optional visit)
  506.   "Documented as original."
  507.  
  508.   (cond
  509.    (jka-compr-enabled
  510.  
  511.     (barf-if-buffer-read-only)
  512.  
  513.     (setq filename (or (jka-compr-find-compressed-version filename)
  514.                filename))
  515.  
  516.     (let ((info (jka-compr-get-compression-info filename)))
  517.  
  518.       (if info
  519.  
  520.       (let ((magic (jka-compr-info-magic info))
  521.         (uncompress-message (jka-compr-info-uncompress-message info))
  522.         (uncompress-program (jka-compr-info-uncompress-program info))
  523.         (discard-err (jka-compr-info-uncompress-discard-err info))
  524.         (uncompress-args (jka-compr-info-uncompress-args info))
  525.         (temp-file (make-temp-name jka-compr-temp-name-template))
  526.         size start)
  527.  
  528.         (and
  529.          uncompress-message
  530.          (message "%sing %s..." uncompress-message
  531.               (file-name-nondirectory filename)))
  532.  
  533.         (if discard-err
  534.  
  535.         (progn
  536.           (call-process
  537.            jka-compr-shell filename nil nil 
  538.            "-c" (format "%s -c %s 2> /dev/null > %s"
  539.                 uncompress-program
  540.                 (mapconcat (function (lambda (x) x))
  541.                        uncompress-args
  542.                        " ")
  543.                 temp-file))
  544.           (setq size (nth 1 (jka-compr-real-insert-file-contents
  545.                      temp-file visit)))
  546.           (jka-compr-real-delete-file temp-file))
  547.  
  548.           (setq start (point))
  549.           (apply 'call-process
  550.              uncompress-program filename t nil
  551.              uncompress-args)
  552.           (setq size (- (point) start))
  553.           (goto-char start))
  554.  
  555.         (and
  556.          visit
  557.          (setq buffer-file-name filename)
  558.          ;; this sets the save_modified field of the buffer
  559.          (set-buffer-modified-p nil)
  560.          ;; this sets the auto_save_modified and save_length of the buffer
  561.          (set-buffer-auto-saved)
  562.          ;; attempt to set the modtime of the buffer by doing a
  563.          ;; dummy write to the file.
  564.          (jka-compr-real-write-region (point) (point) filename t t))
  565.  
  566.         (and
  567.          uncompress-message
  568.          (message "%sing %s...done" uncompress-message
  569.               (file-name-nondirectory filename)))
  570.  
  571.         (list filename size))
  572.  
  573.     (jka-compr-real-insert-file-contents filename visit))))
  574.    (t
  575.     (jka-compr-real-insert-file-contents filename visit))))
  576.     
  577.  
  578.  
  579. ;;; This originally came from uncompress.el
  580. (defun jka-compr-find-compressed-version (filename)
  581.   "If FILENAME does not exist, try to find a compressed version.
  582. Return the version (extended filename) that is found.  If the file
  583. does not exist and no compressed versions are found, return nil."
  584.   (if (jka-compr-real-file-exists-p filename)
  585.       filename
  586.     (catch 'found-compressed-version
  587.       (mapcar
  588.        (function (lambda (cinfo)
  589.            (let ((extended-fname (concat filename (aref cinfo 11))))
  590.              (if (jka-compr-real-file-exists-p extended-fname)
  591.              (throw 'found-compressed-version extended-fname)))))
  592.        jka-compr-compression-info-list)
  593.       nil)))
  594.  
  595.  
  596.  
  597. ;;; There are probably many little functions like this that need to
  598. ;;; be defined.  These seem to to the job for info and rmail.
  599.  
  600.  
  601. (fset
  602.  'jka-compr-real-expand-file-name
  603.  (symbol-function 'expand-file-name))
  604.  
  605.  
  606. (defun jka-compr-file-readable-p (file)
  607.   "Documented as original."
  608.   (if jka-compr-enabled
  609.       (and 
  610.        (setq file (jka-compr-find-compressed-version
  611.            (jka-compr-real-expand-file-name file)))
  612.        (jka-compr-real-file-readable-p file))
  613.     (jka-compr-real-file-readable-p file)))
  614.  
  615.  
  616. (defun jka-compr-file-writable-p (file)
  617.   "Documented as original."
  618.   (if jka-compr-enabled 
  619.       (let ((zfile (jka-compr-find-compressed-version
  620.             (jka-compr-real-expand-file-name file))))
  621.     (if zfile
  622.         (jka-compr-real-file-writable-p zfile)
  623.       (file-directory-p (file-name-directory file))))
  624.     (jka-compr-real-file-writable-p file)))
  625.  
  626.  
  627. (defun jka-compr-verify-visited-file-modtime (buf)
  628.   "Documented as original."
  629.   (and
  630.    jka-compr-enabled
  631.    (not (jka-compr-real-file-exists-p (buffer-file-name buf)))
  632.    (let* ((bfile (buffer-file-name buf))
  633.       (file (jka-compr-find-compressed-version
  634.          (jka-compr-real-expand-file-name bfile)))
  635.       (cbuf (current-buffer)))
  636.      
  637.      (and
  638.       (stringp file)
  639.       (not (string= file bfile))
  640.       (or (not jka-compr-verify-visited-file-change)
  641.       (yes-or-no-p
  642.        (format "Change visited file of buffer %s to %s? "
  643.            (buffer-name buf) file)))
  644.       (set-buffer buf)
  645.       (set-visited-file-name file)
  646.       (set-buffer cbuf))))
  647.   (jka-compr-real-verify-visited-file-modtime buf))
  648.  
  649.  
  650. (defun jka-compr-file-symlink-p (file)
  651.   "Documented as original."
  652.   (if jka-compr-enabled
  653.       (and
  654.        (setq file (jka-compr-find-compressed-version
  655.            (jka-compr-real-expand-file-name file)))
  656.        (jka-compr-real-file-symlink-p file))
  657.     (jka-compr-real-file-symlink-p file)))
  658.  
  659.  
  660. (defun jka-compr-file-attributes (file)
  661.   "Documented as original."
  662.   (if jka-compr-enabled
  663.       (and
  664.        (setq file (jka-compr-find-compressed-version
  665.            (jka-compr-real-expand-file-name file)))
  666.        (jka-compr-real-file-attributes file))
  667.     (jka-compr-real-file-attributes file)))
  668.  
  669.  
  670. (defun jka-compr-file-exists-p (file)
  671.   "Documented as original."
  672.   (if jka-compr-enabled
  673.       (and
  674.        (jka-compr-find-compressed-version
  675.     (jka-compr-real-expand-file-name file))
  676.        t)
  677.     (jka-compr-real-file-exists-p file)))
  678.  
  679.  
  680. (defun jka-compr-delete-file (file)
  681.   "Documented as original."
  682.   (if jka-compr-enabled
  683.       (let (zfile)
  684.     (setq file   (jka-compr-real-expand-file-name file)
  685.           zfile  (or (jka-compr-find-compressed-version file) file))
  686.     (and
  687.      (or (string= zfile file)
  688.          (not jka-compr-verify-delete-file-change)
  689.          (yes-or-no-p (format "Delete file %s? "zfile)))
  690.      (jka-compr-real-delete-file zfile)))
  691.  
  692.     (jka-compr-real-delete-file file)))
  693.  
  694.  
  695. (defun jka-compr-get-file-buffer (file)
  696.   "Documented as original."
  697.   (if jka-compr-enabled
  698.       (or
  699.        (jka-compr-real-get-file-buffer file)
  700.        (and
  701.     (setq file (jka-compr-find-compressed-version
  702.             (expand-file-name file)))
  703.     (jka-compr-real-get-file-buffer file)))
  704.     (jka-compr-real-get-file-buffer file)))
  705.  
  706.   
  707. (defun jka-compr-file-name-sans-versions (name)
  708.   "Documented as original."
  709.   ;; this function assumes that the regexps in jka-compr-compression-info-list
  710.   ;; will find .z extensions even if there are backup flags or version numbers
  711.   ;; attached.
  712.   (if jka-compr-enabled
  713.       (jka-compr-real-file-name-sans-versions
  714.        (catch 'name-sans-compress-extension
  715.      (mapcar
  716.       (function (lambda (x)
  717.               (if (string-match (aref x 0) name)
  718.               (throw 'name-sans-compress-extension 
  719.                  (substring name 0 (match-beginning 0))))))
  720.       jka-compr-compression-info-list)
  721.      name))
  722.     (jka-compr-real-file-name-sans-versions name)))
  723.  
  724.  
  725. ;;; This function was lifted from ange-ftp.  I added some args to make
  726. ;;; it a little more general. - jka
  727. (defun jka-compr-overwrite-fn (fun saved-prefix new-prefix overwrite-msg)
  728.   "Replace FUN's function definition with NEW-PREFIX-FUN's, saving the
  729. original definition as SAVED-PREFIX-FUN.  The original documentation is
  730. placed on the new definition suitably augmented.  Third arg, OVERWRITE-MSG,
  731. is tacked on to the doc string of the new fun."
  732.  
  733.   (let* ((name (symbol-name fun))
  734.      (saved (intern (concat saved-prefix name)))
  735.      (new (intern (concat new-prefix name)))
  736.      (nfun (symbol-function new))
  737.      (exec-directory (if (or (equal (nth 3 command-line-args) "dump")
  738.                  (equal (nth 4 command-line-args) "dump"))
  739.                  "../etc/"
  740.                exec-directory)))             
  741.     
  742.     (while (symbolp nfun)
  743.       (setq nfun (symbol-function nfun)))
  744.     
  745.     (or (fboundp saved)
  746.     (progn
  747.       (fset saved (symbol-function fun))
  748.       (fset fun new)))
  749.     
  750.     (let* ((doc-str (jka-compr-safe-documentation saved))
  751.        (ndoc-str (concat doc-str (and doc-str "\n")
  752.                  overwrite-msg)))
  753.       
  754.       (cond ((listp nfun)
  755.          ;; Probe to test whether function is in preloaded read-only
  756.          ;; memory, and if so make writable copy:
  757.          (condition-case nil
  758.          (setcar nfun (car nfun))
  759.            (error
  760.         (setq nfun (copy-sequence nfun)) ; shallow copy only
  761.         (fset new nfun)))
  762.          (let ((ndoc-cdr (nthcdr 2 nfun)))
  763.            (if (stringp (car ndoc-cdr))
  764.            ;; Replace the existing docstring.
  765.            (setcar ndoc-cdr ndoc-str)
  766.          ;; There is no docstring.  Insert the overwrite msg.
  767.          (setcdr ndoc-cdr (cons (car ndoc-cdr) (cdr ndoc-cdr)))
  768.          (setcar ndoc-cdr overwrite-msg))))
  769.         (t
  770.          ;; it's an emacs19 compiled-code object
  771.          (let ((new-code (append nfun nil))) ; turn it into a list
  772.            (if (nthcdr 4 new-code)
  773.            (setcar (nthcdr 4 new-code) ndoc-str)
  774.          (setcdr (nthcdr 3 new-code) (cons ndoc-str nil)))
  775.            (fset new (apply 'make-byte-code new-code))))))))
  776.  
  777.  
  778. (defun jka-compr-safe-documentation (fun)
  779.   "A documentation function that isn't quite as fragile."
  780.   (condition-case ()
  781.       (documentation fun)
  782.     (error nil)))
  783.  
  784.  
  785. (defvar jka-compr-overwrite-list
  786.   '(
  787.     write-region
  788.     insert-file-contents
  789.     file-readable-p
  790.     file-writable-p
  791.     file-symlink-p
  792.     file-attributes
  793.     file-exists-p
  794.     delete-file
  795.     get-file-buffer
  796.     file-name-sans-versions
  797.     verify-visited-file-modtime
  798.     )
  799.   "List of functions overwritten by jka-compr-install.")
  800.  
  801.  
  802. (mapcar
  803.  (function
  804.   (lambda (fn)
  805.     (jka-compr-overwrite-fn
  806.      fn
  807.      "jka-compr-real-"
  808.      "jka-compr-"
  809.      "Note: This function has been modified to work with jka-compr.")
  810.     )
  811.   )
  812.  jka-compr-overwrite-list)
  813.  
  814.  
  815. (provide 'jka-compr)
  816.  
  817.