From: kazushi@kubota.co.jp (Kazushi (Jam) Marukawa)
Subject: jam-zcat.el-1.40
Organization: Computer Development Engineering Dept., Kubota Co.
Distribution: fj
Date: Tue, 22 Dec 1992 13:28:18 GMT


$B$I$&$b!"$+$:$7!w%/%\%?$G$9!#(B

$B$3$l$O!"(BEmacs$B!"(BNEmacs$B!"(BMule$B$+$i!"(Bcompress$B$d(Bcrypt$B$7$?%U%!%$%k$r%"%/%;%9$9$k(B
$B$?$a$N%Q%C%1!<%8$G$9!#(B

$B$3$l$^$G(BMule$BBP1~(B$B$r$7$F$$$?$N$G$9$,!"$=$m$=$m$"$kDxEY$N$^$H$^$C$?JQ99$,=*$o$C(B
$B$?$?$a!"(Bfj$B$NJ}$K$bEj9F$7$^$9!#(B

$B;H$&$K$O!"0J2<$N(Bshar$B%U%!%$%k$r(Bunshar$B$7$F!"(Bemacs$B$J$I(B$B$+$i(Bload$B$7$F2<$5$$!#(B


 **$B<g$J5!G=$K$D$$$F$NJQ99E@(B**
1. Mule$B$KBP1~$7$?!#(B
2. crypt$B$J$I$N0z?t$rI,MW$H$9$k%W%m%0%i%`$K$bBP1~$7$?!#(B
3. $B%U%!%$%k$,8+IU$+(B$B$i$J$+$C$?;~$K!"(B.Z$B$J$I$rIU$1$?%U%!%$%kL>$N%U%!%$%k$rA\$9(B
   $B$N$G$9$,!"(B$B$=$l$r9bB.2=$7$?!#(B
4. ange-ftp$B$KBP1~$7$?!#8e$+$i(Bange-ftp$B$r(Bload$B$7$F$bLdBj$J$$(B$B!#(B
5. $B4s$;$i$l$?%P%0>pJs$KBP1~$7$?!#(B

 **$B<g$JJQ?t$K$D$$$F$NJQ99E@(B**
1. jam-zcat-filename-alist$B$N9=B$$,JQ$o$C$?!#0JA0$N=q$-J}$G$b8_49@-$O$"$k!#(B

-- $B$+(B$B$:$7(B

#!/bin/sh
# This is a shell archive (produced by shar 3.49)
# To extract the files from this archive, save it to a file, remove
# everything above the "!/bin/sh" line above, and type "sh file_name".
#
# made 12/22/1992 13:22 UTC by kazushi@nekobus
# Source directory /usr1/private/kazushi/lib/mule/mine
#
# existing files will NOT be overwritten unless -c is specified
#
# This shar contains:
# length  mode       name
# ------ ---------- ------------------------------------------
#  26619 -r--r--r-- jam-zcat.el
#
# ============= jam-zcat.el ==============
if test -f 'jam-zcat.el' -a X"$1" != X"-c"; then
	echo 'x - skipping jam-zcat.el (File already exists)'
else
echo 'x - extracting jam-zcat.el (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'jam-zcat.el' &&
;; -*-Emacs-Lisp-*-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; File:         jam-zcat.el
;; RCS:          $Id: jam-zcat.el,v 1.40 1992/12/17 02:40:02 kazushi Exp $
;; Description:  simple file access through SOME PROGRAMS from GNU Emacs
;; Author:       Kazushi Jam Marukawa, kazushi@kubota.co.jp
;; Created:      Fri Jan  4 12:29:21 JST 1991
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
X
;;; Copyright (C) 1991, 1992 Kazushi Marukawa.
;;;
;;; Author: Kazushi Marukawa (kazushi@kubota.co.jp)
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 1, or (at your option)
;;; any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; -- Japanese Documents --
;;; $B$3$N%U%!%$%k$r%m!<%I$7$F$*$/$H!"(B$B%3%s%W%l%9$5$l$?%U%!%$%k$r!"(B``Mule''$B$d(B
;;; ``NEmacs''$B!"(B``Emacs''$B$+$i!"IaDL$N%U(B$B%!%$%k$H$^$C$?$/0c$$$J$/%"%/%;%9$G$-(B
;;; $B$k$h$&$K$J$j$^$9!#(B
;;;
;;; $B$H$$(B$B$&$h$j!"9%$-$J%U%!%$%kL>$N%U%!%$%k$r9%$-$J%W%m%0%i%`$r2p$7$FF~=PNO(B
;;; $B$9$k$3$H$,$G$-$k$h$&$K$J$j$^$9!#(B
;;;
;;; $BFbIt$G$O!"%3%s%W%l%9$5$l$?%U(B$B%!%$%k$rFI$_9~$`;~$K$O!"$^$:$=$N$^$^FI$_9~(B
;;; $B$_%P%C%U%!Cf$G%"%s%3%s(B$B%W%l%9$9$k$H$$$C$?:n6H$r!"%3%s%W%l%9$5$l$?%U%!%$(B
;;; $B%k$H$7$F=q$-9~$`(B$B;~$K$O!"%P%C%U%!Cf$G%3%s%W%l%9$7$?8e$K=q$-9~$`$H$$$C$?(B
;;; $B:n6H$r9T$C(B$B$F$$$^$9!#$=$7$F$=$N:]$K!"4A;z%3!<%I$NJQ49$dJQ49$NM^@)$b9T$C(B
;;; $B$F$$(B$B$^$9!#(B
;;;
;;; $B@_Dj$G$-$kJQ?t$O(Bjam-zcat-filename-list$B!"(Bjam-zcat-hack-ange-ftp$B!"(B
;;; jam-zcat-hack-loadablep$B!"(Bjam-zcat-si-mode$B$G$9!#(B
;;;
;;; jam-zcat-filename-list:
;;; $B$3$N%j%9%H$N(B$BMWAG$O!"(B(((REGEXP . STRRPL) (REGEXP . STRRPL)...)
;;; COMPRESSPROG UNCOMPRESSPROG UNCOMPRESSERRORSTR [COMPRESSARG
;;; [UNCOMPRESSARG]])$B$H$$$C$?7A$r$7$F$$$^$9!#(B
;;;
;;; $B$9$Y$F$N%U%!(B$B%$%kL>$O!"(B(REGEXP . STRRPL)$B$NAH$K$h$C$FI>2A$5$l$^$9!#:G=i$N(B
;;; $BAH$NCf$N(BREGEXP$B$K%^%C%A$7$?>l9g$O!"%^%C%A$7$?ItJ,$r(BSTRRPL$B$GCV$-49$($?%U%!(B
;;; $B%$%kL>$,(B$B@5<0$J(B($BNc$($P%"%s%3%s%W%l%98e$N(B)$BL>A0$H$7$F07$o$l$^$9!#$^$?!"$b(B
;;; $B$7$=(B$B$N%U%!%$%kL>$N%U%!%$%k$,8+IU$+$i$J$$>l9g$K$O!";D$j$NAH$K$h$C$FI>2A(B
;;; $B$5$l$^$9!#;D$j$NAH$NCf$N(BREGEXP$B$K%^%C%A$7$?>l9g$O!";XDj$5$l$?L>A0$,@5(B$B<0(B
;;; $B$JJ*$G!"$=$l$rCV$-49$($?%U%!%$%kL>$,<B:]$N(B($BNc$($P%3%s%W%l%98e$N(B)$B%U%!%$(B
;;; $B%kL>$H$7$F<h$j07$o$l$^$9!#(B
;;;
;;; $B$3$N%Q%C%1!<%8$G$O!"$3$l$i(B$B$N(BREGEXP$B$K%^%C%A$7$?%U%!%$%kL>$N%U%!%$%k$KBP(B
;;; $B$9$kF~=PNO$r=hM}$7$^$9(B$B!#$^$?@5<0$JL>A0$O!"<B:]$NJT=8;~$N%P%C%U%!$N%b!<(B
;;; $B%I$J$I$r7hDj$9$k(B$B$?$a$KMQ$$$i$l$^$9!#(B
;;;
;;; COMPRESSPROG$B$G$O%3%s%W%l%9$9$k$?$a$KMxMQ$9$k%W(B$B%m%0%i%`L>$r!"F1MM$K(B
;;; UNCOMPRESSPROG$B$G$O%"%s%3%s%W%l%9$9$k$?$a$KMxMQ$9$k(B$B%W%m%0%i%`L>$r;XDj$7(B
;;; $B$^$9!#(BUNCOMPRESSERRORSTR$B$G$O!"%"%s%3%s%W%l%9$K<:GT(B$B$7$?;~$K%W%m%0%i%`$,(B
;;; $B=PNO$9$k%(%i!<%a%C%;!<%8$r;XDj$7$^$9!#(B
;;;
;;; $B$^$?!"(BCOMPRESSARG$B$H(BUNCOMPRESSARG$B$rMxMQ$7$F!"$=$l$i$N%W%m%0%i%`$GMxMQ$9(B
;;; $B$k(B$B0z?t$r;XDj$9$k$3$H$b$G$-$^$9!#$3$l$i$O(Beval$B$K$h$C$FI>2A$5$l!"$=$N7k2L(B
;;; $B$r0z?t$N%j%9%H$H$7$FMQ$$$^$9!#$b$7(BUNCOMPRESSARG$B$,;XDj$5$l$F$$$J$1$l$P(B$B!"(B
;;; $B$=$NBe$j$K(BCOMPRESSARG$B$rMxMQ$7$^$9!#(B
;;;
;;; $BNc$($P!"(B((("\\.taz$" . ".tar") ("\\.tar$" . ".taz") ("$" . ".taz"))
;;; "compress" "uncompress" "stdin: not in compressed format\n")$B$H(B$B$$$&%j%9(B
;;; $B%H$,$"$C$?>l9g$K$O!"(B.taz$B$H$$$&%U%!%$%kL>$G=*$o$C$F$$$k%U%!(B$B%$%k$rFI$_9~(B
;;; $B$s$@>l9g$O!"(B uncompress$B$rMQ$$$F%"%s%3%s%W%l%9$r9T$$!"(B.taz$B$NItJ,$r(B.tar$B$H(B
;;; $BCV$-49$($?L>A0$rMQ$$$F%P%C%U%!$N%b!<%I$r@_Dj$7$^$9!#(B$B$=$l$r=q$-9~$`;~$K(B
;;; $B$O(Bcompress$B$rMQ$$$F%3%s%W%l%9$r9T$$=q$-9~$_$^$9!#$^(B$B$?!"(Btest.tar$B$H$$$C$?(B
;;; $B%U%!%$%kL>$rMQ$$$F(Bfind-file$B$K<:GT$7$?>l9g$K$O!"$^$:(B.tar$B$NItJ,$r(B.tar$B$GCV(B
;;; $B$-49$($F(Btest.taz$B$H$$$&%U%!%$%kL>$N%U%!%$%k$rC5$7!"(B$B<!$K(B.taz$B$r:G8e$KIU$1(B
;;; $B2C$($F(Btest.tar.taz$B$H$$$&%U%!%$%kL>$N%U%!%$%k$rC5$9(B$B$H$$$C$?F0:n$r9T$$$^(B
;;; $B$9!#(B
;;;
;;; $B$^$?!"(B((("\\.cry$" . "") ("" . ".cry")) "crypt" "crypt" nil
;;; (jam-zcat-get-crypt-key))$B$H$$$C$?%j%9%H$rMxMQ$9$k$H!"(Bcrypt$B$rMxMQ$7$F(B$B%U%!(B
;;; $B%$%kF~=PNO$r9T$&$3$H$b$G$-$^$9!#(B
;;;
;;; $B0l1~8E$$%P!<%8%g%s$N;~(B$B$N=q$-J}$G=q$+$l$?(Bjam-zcat-filename-list$B$K$bBP1~(B
;;; $B$7$F$$$^$9$,!"(Bfind-file$B$,<:(B$BGT$7$?>l9g$K<+F08!:w$r9T$($J$/$J$j$^$9$+$i!"(B
;;; $B$3$N?7$7$$=q$-J}$rMx(B$BMQ$7$F2<$5$l$P9,$$$G$9!#(B
;;;
;;; jam-zcat-hack-ange-ftp:
;;; $B$3$N%U%i%0$rN)$F$F$*(B$B$/$H!"$3$N%Q%C%1!<%8$r%m!<%I$7$?8e$K!"(Bange-ftp$B$r%m!<(B
;;; $B%I$7$F$$$F$b!"@5(B$B$7$/F0:n$9$k$h$&$K$J$j$^$9!#$A$J$_$K!"(Bange-ftp$B$r%m!<%I(B
;;; $B$7$?8e$K$3$N%Q(B$B%C%1!<%8$r%m!<%I$9$kJ,$K$O2?$NLdBj$b$"$j$^$;$s!#(B
;;;
;;; jam-zcat-hack-loadablep:
;;; ``Mule''$B$K$*$$$F!"$3$N%U%i%0$rN)$F$F$*$/$H!"(Bload$B4X?t$K$*$$$F$b(B``.Z''$B$N(B
;;; $BIU$$$?(Belisp$B$N%U%!%$%k$r%m!<%I$9$k$3$H$,$G$-$k$h$&$K$J$j$^$9!#(B
;;;
;;; jam-zcat-si-mode:
;;; ``Mule''$B$K$*$$$F!"$3$N%U%i%0$rN)$F$F$*$/$H!"(B``si:''$B$,IU(B$B$$$?4X?t$rCV$-49(B
;;; $B$($k$h$&$K$J$j$^$9!#$3$l$K$h$C$FF~=PNO;~$N(Bpre-hook$B$d(Bpost-hook$B$,@_Dj$5$l(B
;;; $B$F$$$?>l9g$K$b$&$^$/F0:n$9$k$h$&$K$J$k$O$:$G$9!#(B
;;;
;;; **$BCm0UE@(B**
;;; $B$7$+$7$3$l$i$N5!G=$r<B8=$9$k$K$"$?$C$F!"0J2<$K5s$2(B$B$k4X?t$rCV$-49$($F$$(B
;;; $B$^$9!#(B
;;;
;;; NEmacs$B$d!"(BEmacs$B$N>l9g(B:
;;;   write-region
;;;   insert-file-contents
;;;   normal-mode
;;;   get-file-buffer
;;;
;;; Mule$B$N>l9g(B:
;;;   si:write-region$B$+(Bwrite-region
;;;   si:insert-file-contents$B$+(Binsert-file-contents
;;;   normal-mode
;;;   get-file-buffer
;;;   loadablep
;;;
;;; $B$G$9$+$i!"$3$3$K5s$2$?4X?t$K%Q%C%A$rEv$F(B$B$k7A<0$N%W%m%0%i%`$rMxMQ$9$k>l(B
;;; $B9g$O!"$3$l$i$N4X?t$,8F$P$l$k=gHV$r(B$B9M$($F%m!<%I$9$kI,MW$,$"$j$^$9!#$?$@(B
;;; $B$7(Bange-ftp$B$K$D$$$F$OBP1~:Q$_$G$9(B$B$+$i!"$I$A$i$r@h$K%m!<%I$7$F$bLdBj$J$/(B
;;; $BF0:n$7$^$9!#(Bange-ftp$B$r(Bautoload$B$9(B$B$k$J$I$H$$$C$?$3$H$b2DG=$G$7$g$&!#(B
;;;
;;; **$B8=:_$NLdBjE@(B**
;;; NEMACS$B$N>l9g(B:
;;; callproc.c$BCf$N(Bcall-process-region$B4X?t$G(Bkanji-flag$B$N%A%'%C%/$r$7$F$$$J$$(B
;;; $B$?(B$B$a!"$b$7%f!<%6$,(Bfind-kanji-process-code$B4X?t$J$I$r<+J,$G:n$C$F$$$k>l9g(B
;;; $B$J$I(B$B$K$O!"%P%$%J%j%G!<%?$r(Bprocess$B$HF~=PNO$7$F$$$k$K$b$+$+$o$i$:4A;zJQ49(B
;;; $B$,9T$o$l$k4m81$,$"$j$^$9!#I8=`$N(BNemacs$B$G;H$o$l$F$$$k$J$iBg>fIW$G$9$,!#(B
;;;
;;; $BI8=`$N(Bfind-kanji-file-output-code$BEy$G$O%"%Z%s%I;~$N4A;z%3!<%I%A%'%C%/$r(B
;;; $BFC$K9T$J$C$F$$$^$;$s!#$=$N$?$a%"%Z%s%I$9$k$?$a$K(Bwrite-region$B$rMxMQ$9(B$B$k(B
;;; $B$H!"$=$N%U%!%$%k$N4A;z%3!<%I$,JQ$o$C$F$7$^$&$3$H$,$"$j$^$9!#(B
;;;
;;; MULE$B$N>l9g(B:
;;; $BI8=`E*$J4A;z%3!<%I<1JL4X?t$,!"8E$$%P!<%8%g%s$N(BMULE$B$G(B$B$OMQ0U$5$l$F$$$^$;(B
;;; $B$s$G$7$?!#$=$N$?$a$K!"<1JL4X?t$rFH<+$K:n@.$7$F(B$B=hM}$r9T$C$F$$$^$9!#(B
;;;
;;; **$B:G8e$K(B***
;;; $B$5$F:G8e$K$J$j$^$7$?$,!"4X?t$r(B$BCV$-49$($k$H$$$&%"%$%G%#%"$H!"$=$N4J7i$J(B
;;; $BJ}K!$,5-=R$5$l$F$$$k!"(B`ange-ftp.el(by ange@hplb.hpl.hp.com)$B$,BgJQ;29M$K(B
;;; $B$J$C$F$$$^$9!#46<U$7$^$9!#(B
;;;
;;; $B$^$?0J2<$N%P%0$N;XE&$d=u8@$rM?$($F$/$l$?J}!9$K$b46<U$7$^$9!#(B
;;;  $B8E(B$BNS5*:H(B Noriya KOBAYASHI :<nk@ics.osaka-u.ac.jp>
;;;  $BKYFbJ]=((B Horiuchi Yasuhide:<homy@cs.titech.ac.jp>
;;;  $BFj:j=$Fs(B NARAZAKI Shuji   :<narazaki@nttslb.ntt.jp>
;;;  $B9-@n0lIW(B Kazuo Hirokawa   :<hirokawa@rics.co.jp>
;;;
;;; $B2?$+LdBj$,$"$j$^$7$?$i!"(Bkazushi@kubota.co.jp$B$^$G$*CN(B$B$i$;2<$5$$!#(B
;;;
X
;;; Variable which can be set by USER.
;;;
(defvar jam-zcat-filename-list
X  '(((("\\.Z$" . "") ("$" . ".Z")) "compress" "uncompress"
X     "stdin: not in compressed format\n")
X    ((("\\.taz$" . ".tar") ("\\.tar$" . ".taz") ("$" . ".taz"))
X     "compress" "uncompress"
X     "stdin: not in compressed format\n")
X    ((("\\.Y$" . "") ("$" . ".Y")) "yabba" "unyabba"
X     "unyabba: fatal: input not in right format\n"))
X  " Each element looks like (((REGEXP . STRRPL) (REGEXP . STRRPL)...)
COMPRESSPROG UNCOMPRESSPROG UNCOMPRESSERRORSTR [COMPRESSARG [UNCOMPRESSARG]]).
X
X Reading a file whose name matches first REGEXP cause uncompress it and
choose major mode from real-filename that is created replacing matched area
to first STRRPL.  If file not found, search compressed file with
substituted file name by rest (REGEXP . STRRPL)s.
X
X COMPRESSPROG is compressing program name, UNCOMPRESSPROG is uncompressing
program name.  UNCOMPRESSERRORSTR is error string when uncompressing.
Each of these 3 argument must be a string.
X
X When compressing, COMPRESSARG is evaluated and use result as a argument
list for compressing.  UNCOMPRESSARG is evaluated when uncompressing, but
if there is no UNCOMPRESSARG, COMPRESSARG is used as UNCOMPRESSARG.
X
X Note for old version:
X Each element of old version looks like ((REGEXP . STRRPL) COMPRESSPROG
UNCOMPRESSPROG UNCOMPRESSERRORSTR).  And it supported.")
X
(defvar jam-zcat-hack-ange-ftp t
X  "Non nil means hack to get real filename when using the ange-ftp.")
X
(defvar jam-zcat-hack-loadablep t
X  "On the Mule, non nil means hack to load compressed file.")
X
(defvar jam-zcat-si-mode t
X  "On the Mule, non nil means that this package patch to
si:insert-file-contents and si:write-region.")
X
;;; Internal variables.
;;;
(defvar jam-zcat-how-to-list nil
X  "Current one of jam-zcat-filename-list.")
X
;;; Internal routines.
;;;
(defun jam-zcat-error-p ()
X  "Check a uncompress program's error message."
X  (let ((sexp (nth 3 jam-zcat-how-to-list)))
X    (cond ((stringp sexp)
X	   (string= (buffer-substring
X		     (point-min)
X		     (min (point-max) (+ (point-min) (length sexp))))
X		    sexp))
X	  (sexp (eval sexp)))))
X
(defun jam-zcat-substitute-string (str slist)
X  "Return substituted string for STRING.  Replaces matched text by regular
expression of (car SLIST) with (cdr SLIST)."
X  (if (string-match (car slist) str)
X      (concat (substring str 0 (match-beginning 0))
X	      (cdr slist)
X	      (substring str (match-end 0) nil))))
X
(defun jam-zcat-filename-to-realname (fname)
X  "Convert FILENAME to real filename, if it was compressed."
X  (and (stringp fname)
X       (let ((case-fold-search (eq system-type 'vax-vms)))
X	 (catch 'exit
X	   (mapcar (function
X		    (lambda (how-to)
X		      (let* ((name-conv (if (stringp (car (car how-to)))
X					    (car how-to)
X					  (car (car how-to))))
X			     (realname (jam-zcat-substitute-string
X					fname name-conv)))
X			(if realname
X			    (progn
X			      (setq jam-zcat-how-to-list how-to)
X			      (throw 'exit realname))))))
X		   jam-zcat-filename-list)
X	   fname))))
X
(defmacro jam-zcat-localize-code (&optional MULE-CODE NEMACS-CODE EMACS-CODE)
X  "If this called on Mule, eval MULE-CODE.  If on NEmacs, eval NEMACS-CODE.
Otherwise eval EMACS-CODE or NEMACS-CODE(if EMACS-CODE is nil)."
X  (cond ((boundp 'MULE) MULE-CODE)
X	((boundp 'NEMACS) NEMACS-CODE)
X	(t (if EMACS-CODE EMACS-CODE NEMACS-CODE))))
X
(defun jam-zcat-read-string-no-echo (prompt &optional default)
X  "Read a string from the user. Echos a . for each character typed.
End with RET, LFD, or ESC. DEL or C-h rubs out.  ^U kills line.
Optional DEFAULT is string to start with."
X  (let ((str (if default default ""))
X	(c 0)
X	(echo-keystrokes 0)
X	(cursor-in-echo-area t))
X    (while (and (/= c ?\r) (/= c ?\n) (/= c ?\e))
X      (message "%s%s"
X	       prompt
X	       (make-string (length str) ?.))
X      (setq c (read-char))
X      (if (= c ?\C-u)
X	  (setq str "")
X	(if (and (/= c ?\b) (/= c ?\177))
X	    (setq str (concat str (char-to-string c)))
X	  (if (> (length str) 0)
X	      (setq str (substring str 0 -1))))))
X    (message "")
X    (substring str 0 -1)))
X
(defun jam-zcat-get-crypt-key ()
X  (if (and (boundp 'crypt-key) crypt-key)
X      crypt-key
X    (make-variable-buffer-local 'crypt-key)
X    (setq crypt-key (list (jam-zcat-read-string-no-echo
X			   "Set key for cryptogram: ")))
X    crypt-key))
X
(jam-zcat-localize-code
X (defun code-detect-like-fileio (start end)
X   "Detect kanji code of buffer string with algolithm like original
insert-file-contents function."
X   (let ((code (code-detect-region start end 1)))
X     (cond ((equal code (get '*internal-code-category* 'code-priority-value))
X	    *internal*)
X	   ((equal code (get '*sjis-code-category* 'code-priority-value))
X	    *sjis*)
X	   ((equal code (get '*junet-code-category* 'code-priority-value))
X	    *junet*)
X	   ((equal code (get '*euc-code-category* 'code-priority-value))
X	    *euc-japan*)
X	   ((equal code (get '*ctext-code-category* 'code-priority-value))
X	    *ctext*)
X	   ((equal code (get '*big5-code-category* 'code-priority-value))
X	    *big5-hku*)))))
X
;;; Routines will replease original one.
;;;
(defun jam-zcat-insert-file-contents (filename &optional visit &rest code)
X  "Documented as original."
X  (barf-if-buffer-read-only)
X  (setq filename (expand-file-name filename))
X  (let ((realname (jam-zcat-filename-to-realname filename))
X	(realfilename filename)
X	(modp (buffer-modified-p))
X	result result-code)
X    ;; Support Ange-ftp
X    (if (and (fboundp 'ange-ftp-insert-file-contents) jam-zcat-hack-ange-ftp
X	     (boundp 'parsed) parsed
X	     (boundp 'path) (stringp path))
X	;; now be called through ange-ftp, hack it!
X	(progn
X	  (setq realname (jam-zcat-filename-to-realname path))
X	  (setq realfilename path)))
X    (if (string= realname realfilename)
X	(apply 'jam-zcat-real-insert-file-contents filename visit code)
X      (setq result			; READ file without any conversion
X	    (jam-zcat-localize-code
X	     (if code
X		 (cdr (jam-zcat-real-insert-file-contents filename
X							  visit *noconv*))
X	       (let ((file-coding-system-for-read *noconv*)
X		     file-coding-system)
X		 (jam-zcat-real-insert-file-contents filename visit)))
X	     (let (kanji-flag)
X	       (jam-zcat-real-insert-file-contents filename visit))))
X      (save-excursion
X	(save-restriction
X	  (narrow-to-region (point) (+ (point) (nth 1 result)))
X					; UNCOMPRESS without kanji code conv.
X	  (message "Uncompressing %s ..." realfilename)
X	  (condition-case err
X	      (progn
X		(let ((args (eval (or (nth 5 jam-zcat-how-to-list)
X				      (nth 4 jam-zcat-how-to-list)))))
X		  (jam-zcat-localize-code
X		   (let ((default-process-coding-system
X			   (cons *noconv* *noconv*))
X			 (kill-it
X			  (not (local-file-coding-system-p))) ; for Mule BUG
X			 process-connection-type
X			 mc-flag)
X		     (apply 'call-process-region (point) (point-max)
X			    (nth 2 jam-zcat-how-to-list) t t nil args)
X		     (if kill-it
X			 (kill-local-variable 'file-coding-system)))
X		   (let (kanji-flag
X			 default-kanji-process-code
X			 service-kanji-code-alist
X			 program-kanji-code-alist
X			 process-connection-type)
X		     (apply 'call-process-region (point) (point-max)
X			    (nth 2 jam-zcat-how-to-list) t t nil args))))
X		(if (jam-zcat-error-p)
X		    (signal 'file-error
X			    (list
X			     "Uncompressing input file"
X			     (format "Unable to %s input file"
X				     (upcase (nth 2 jam-zcat-how-to-list)))
X			     realfilename))))
X	    (file-error
X	     (cond ((not visit)
X		    (delete-region (point-min) (point-max))
X		    (set-buffer-modified-p modp))
X		   (t
X		    (set-buffer-modified-p modp)
X		    (kill-buffer (current-buffer))))
X	     (apply 'error "%s: %s, %s" (cdr err))))
X	  (message "Uncompressing %s ... done" realfilename)
X	  (jam-zcat-localize-code	; CONVERT kanji code
X	   (if mc-flag
X	       (let ((code (cond ((or (null (nth 0 code))
X				      (equal (nth 0 code) *autoconv*))
X				  (code-detect-like-fileio (point-min)
X							   (point-max)))
X				 (t (nth 0 code)))))
X		 (setq result-code code)
X		 (if code (code-convert-region (point-min) (point-max)
X					       code *internal*))))
X	   (if (and (boundp 'kanji-flag) kanji-flag)
X	       (let ((code (invoke-find-kanji-file-input-code
X			    realname visit (point-min) (point-max))))
X		 (if (or (eq code 1) (eq code 2))
X		     (progn
X		       (convert-region-kanji-code (point-min) (point-max)
X						  code 3))))))
X	  (if visit
X	      (set-buffer-modified-p modp))))
X      (if code
X	  (list result-code (car result) (point-max))
X	(jam-zcat-localize-code
X	 (if (not file-coding-system)	; On Mule, now CHANGE buffer kanji code
X
X	     (set-file-coding-system result-code))
X					; On NEmacs, CHANGED buffer kanji code
X					; at invoke-find-kanji-file-input-code
X	 )
X	(list (car result) (point-max))))))
X
(defun jam-zcat-normal-mode (&optional find-file)
X  "Documented as original."
X  (let ((buffer-file-name (jam-zcat-filename-to-realname buffer-file-name)))
X    (jam-zcat-real-normal-mode find-file)))
X
(defun jam-zcat-write-region (start end filename &optional append visit
X				    &rest code)
X  "Documented as original."
X  (interactive "r\nFWrite region to file: ")
X  (setq filename (expand-file-name filename))
X  (let ((realname (jam-zcat-filename-to-realname filename))
X	(realfilename filename))
X    ;; Support Ange-ftp
X    (if (and (fboundp 'ange-ftp-insert-file-contents) jam-zcat-hack-ange-ftp
X	     (boundp 'parsed) parsed
X	     (boundp 'path) (stringp path))
X	;; now be called through ange-ftp, hack it!
X	(progn
X	  (setq realname (jam-zcat-filename-to-realname path))
X	  (setq realfilename path)))
X    (if (string-equal realname realfilename)
X	(apply 'jam-zcat-real-write-region start end filename append visit
X	       code)
X      (let ((temp (get-buffer-create "*compress*"))
X	    (cbuf (current-buffer))
X	    (save-start (make-marker))
X	    kcode)
X	(save-restriction
X	  (narrow-to-region start end)
X	  (cond ((not append)
X		 (setq kcode		; GET kanji code for conv.
X		       (jam-zcat-localize-code
X			(if mc-flag
X			    (or (nth 0 code)
X				(if (and current-prefix-arg (interactive-p))
X				    (read-coding-system "Coding-system: ")
X				  file-coding-system)))
X			(if (and (boundp 'kanji-flag) kanji-flag)
X			    (invoke-find-kanji-file-output-code
X			     start end realname append visit))))
X		 (set-buffer temp)
X		 (erase-buffer))
X		(t
X		 (set-buffer temp)
X		 (erase-buffer)
X					; READ target file
X		 (insert-file-contents filename nil)
X		 (setq kcode		; GET kanji code of target file
X		       (jam-zcat-localize-code
X			(if mc-flag
X			    (or file-coding-system kcode))
X			(if (and (boundp 'kanji-flag) kanji-flag)
X			    (or (invoke-find-kanji-file-output-code
X				 start end realname append visit)
X				kcode))))))
X	  (goto-char (point-max))
X	  (insert-buffer cbuf)
X	  (jam-zcat-localize-code
X	   nil				; On Mule, will CONVERT it at
X					; call-process-region
X					; On NEmacs, CONVERT kanji code
X	   (if (or (eq kcode 1) (eq kcode 2))
X	       (convert-region-kanji-code (point-min) (point-max)
X					  3 kcode)))
X	  (unwind-protect
X	      (progn
X		(condition-case err
X		    (progn		; COMPRESS without/with kanji code
X					; conv.
X		      (message "Compressing %s ..." realfilename)
X		      (let ((args (prog2
X				   (set-buffer cbuf)
X				   (eval (nth 4 jam-zcat-how-to-list))
X				   (set-buffer temp))))
X			(jam-zcat-localize-code
X			 (let ((default-process-coding-system
X				 (cons *noconv* kcode))
X			       process-connection-type)
X			   (apply 'call-process-region (point-min) (point-max)
X				  (nth 1 jam-zcat-how-to-list) t t nil args))
X			 (let (kanji-flag
X			       default-kanji-process-code
X			       service-kanji-code-alist
X			       program-kanji-code-alist
X			       process-connection-type)
X			   (apply 'call-process-region (point-min) (point-max)
X				  (nth 1 jam-zcat-how-to-list) t t nil args))))
X		      (message "Compressing %s ...done" realfilename))
X		  (file-error
X		   (apply 'error "%s: %s, %s" (cdr err))))
X		(if (eq visit t)
X		    (progn
X		      (set-buffer cbuf)
X		      (let (buffer-read-only)
X			(set-marker save-start (point))
X			(insert-buffer-substring temp)))
X		  (set-marker save-start (point-min)))
X		(jam-zcat-localize-code	; WRITE file without any conversion
X		 (if code
X		     (let (mc-flag selective-display)
X		       (jam-zcat-real-write-region save-start (point) filename
X						   nil visit *noconv*))
X		   (let ((file-coding-system *noconv*) mc-flag
X			 selective-display)
X		     (jam-zcat-real-write-region save-start (point)
X						 filename nil visit)))
X		 (let (kanji-flag selective-display)
X		   (jam-zcat-real-write-region save-start (point)
X					       filename nil visit)))
X		(if (eq visit t)
X		    (let (buffer-read-only)
X		      (delete-region save-start (point))
X		      (set-buffer-modified-p nil))
X		  (set-buffer cbuf))
X		nil)
X	    (kill-buffer temp))
X	  )))))
X
(defun jam-zcat-get-file-buffer (filename)
X  "Documented as original."
X  (setq filename (expand-file-name filename))
X  (or (jam-zcat-real-get-file-buffer filename)
X      (if (file-exists-p filename)
X	  nil
X	(catch 'exit
X	  (mapcar (function
X		   (lambda (buf)
X		     (if (string= (jam-zcat-filename-to-realname
X				   (buffer-file-name buf)) filename)
X			 (throw 'exit buf))))
X		  (buffer-list))
X	  nil))))
X
(defun jam-zcat-loadablep (str &optional nosuffix)
X  "Documented as original."
X  (if (not jam-zcat-hack-loadablep)
X      (jam-zcat-real-loadablep str nosuffix)
X    (catch 'exit
X      (mapcar
X       '(lambda (dir)
X	  (let ((file (expand-file-name str dir)))
X	    (mapcar
X	     '(lambda (ext)
X		(if (file-readable-p (concat file ext))
X		    (throw 'exit (concat file ext))))
X	     (if nosuffix
X		 '(nil)
X	       '(".elc" ".el" ".elc.Z" ".el.Z")))))
X       load-path)
X      nil)))
X
;;; Routines to replace.
;;;   Original cames from ange-ftp v4.20
;;;
(defvar jam-zcat-overwrite-msg
X  "Note: This function has been extended to deal with compressed file.")
X
(defun jam-zcat-safe-documentation (fun)
X  "A documentation function that isn't quite as fragile."
X  (condition-case ()
X      (documentation fun)
X    (error nil)))
X
(defun jam-zcat-overwrite-fn (fun)
X  "Replace FUN's function definition with jam-zcat-FUN's, saving the
original definition as jam-zcat-real-FUN.  The original documentation is
placed on the new definition suitably augmented."
X  (let* ((name (symbol-name fun))
X	 (saved (intern (concat "jam-zcat-real-" name)))
X	 (new (intern (concat "jam-zcat-" name)))
X	 (nfun (symbol-function new))
X	 (exec-directory (if (or (equal (nth 3 command-line-args) "dump")
X				 (equal (nth 4 command-line-args) "dump"))
X			     "../etc/"
X			   exec-directory)))			 
X    
X    ;; *** This is unnecessary for any jam-zcat function (I think):
X    (while (symbolp nfun)
X      (setq nfun (symbol-function nfun)))
X    
X    ;; Interpose the jam-zcat function between the function symbol and the
X    ;; original definition of the function symbol AT TIME OF FIRST LOAD.
X    ;; We must only redefine the symbol-function of FUN the very first
X    ;; time, to avoid blowing away stuff that overloads FUN after this.
X    
X    ;; We direct the function symbol to the jam-zcat's function symbol
X    ;; rather than function definition to allow reloading of this file or
X    ;; redefining of the individual function (e.g., during debugging)
X    ;; later after some other code has been loaded on top of our stuff.
X    
X    (or (fboundp saved)
X	(progn
X	  (fset saved (symbol-function fun))
X	  (fset fun new)))
X    
X    ;; Rewrite the doc string on the new jam-zcat function.  This should
X    ;; be done every time the file is loaded (or a function is redefined),
X    ;; because the underlying overloaded function may have changed its doc
X    ;; string.
X    
X    (let* ((doc-str (jam-zcat-safe-documentation saved))
X	   (ndoc-str (concat doc-str (and doc-str "\n")
X			     jam-zcat-overwrite-msg)))
X      
X      (cond ((listp nfun)
X	     ;; Probe to test whether function is in preloaded read-only
X	     ;; memory, and if so make writable copy:
X	     (condition-case nil
X		 (setcar nfun (car nfun))
X	       (error
X		(setq nfun (copy-sequence nfun)) ; shallow copy only
X		(fset new nfun)))
X	     (let ((ndoc-cdr (nthcdr 2 nfun)))
X	       (if (stringp (car ndoc-cdr))
X		   ;; Replace the existing docstring.
X		   (setcar ndoc-cdr ndoc-str)
X		 ;; There is no docstring.  Insert the overwrite msg.
X		 (setcdr ndoc-cdr (cons (car ndoc-cdr) (cdr ndoc-cdr)))
X		 (setcar ndoc-cdr jam-zcat-overwrite-msg))))
X	    (t
X	     ;; it's an emacs19 compiled-code object
X	     (let ((new-code (append nfun nil))) ; turn it into a list
X	       (if (nthcdr 4 new-code)
X		   (setcar (nthcdr 4 new-code) ndoc-str)
X		 (setcdr (nthcdr 3 new-code) (cons ndoc-str nil)))
X	       (fset new (apply 'make-byte-code new-code))))))))
X
(jam-zcat-localize-code
X (cond (jam-zcat-si-mode
X	(fset 'jam-zcat-si:insert-file-contents
X	      (symbol-function 'jam-zcat-insert-file-contents))
X	(jam-zcat-overwrite-fn 'si:insert-file-contents)
X	(fset 'jam-zcat-real-insert-file-contents
X	      (symbol-function 'jam-zcat-real-si:insert-file-contents))
X	(fset 'jam-zcat-si:write-region
X	      (symbol-function 'jam-zcat-write-region))
X	(jam-zcat-overwrite-fn 'si:write-region)
X	(fset 'jam-zcat-real-write-region
X	      (symbol-function 'jam-zcat-real-si:write-region))
X	(jam-zcat-overwrite-fn 'loadablep))
X       (t
X	(jam-zcat-overwrite-fn 'insert-file-contents)
X	(jam-zcat-overwrite-fn 'write-region)))
X (progn
X   (jam-zcat-overwrite-fn 'insert-file-contents)
X   (jam-zcat-overwrite-fn 'write-region)))
(jam-zcat-overwrite-fn 'normal-mode)
(jam-zcat-overwrite-fn 'get-file-buffer)
X
;;; Routines for hook.
;;;
(defun jam-zcat-search-compressed-file (name)
X  (catch 'exit
X    (mapcar (function
X	     (lambda (how-to)
X	       (if (consp (cdr (car how-to)))
X		   (mapcar (function
X			    (lambda (rev-name-conv)
X			      (let ((fname (jam-zcat-substitute-string
X					    name rev-name-conv)))
X				(if (and fname
X					 (file-exists-p fname))
X				    (throw 'exit fname)))))
X			   (cdr (car how-to))))
X	       nil))
X	    jam-zcat-filename-list)
X      nil))
X
(defun jam-zcat-find-file-not-found-hook ()
X  " Called when a find-file command has not been able to find the specfied
file. Read and uncompress when a compressed file exists."
X  (if (string= (jam-zcat-filename-to-realname buffer-file-name)
X	       buffer-file-name)
X      (let ((compressed-file (jam-zcat-search-compressed-file
X			      buffer-file-name)))
X	(if compressed-file
X	    (progn
X	      (setq buffer-file-name compressed-file)
X	      (insert-file-contents compressed-file t)
X	      (setq error nil)
X	      t)))))
X
(or (memq 'jam-zcat-find-file-not-found-hook find-file-not-found-hooks)
X    (setq find-file-not-found-hooks
X	  (cons 'jam-zcat-find-file-not-found-hook find-file-not-found-hooks)))
X
;;; Other stuff
;;;
(provide 'jam-zcat)
(run-hooks 'jam-zcat-load-hook)
SHAR_EOF
chmod 0444 jam-zcat.el ||
echo 'restore of jam-zcat.el failed'
Wc_c="`wc -c < 'jam-zcat.el'`"
test 26619 -eq "$Wc_c" ||
	echo 'jam-zcat.el: original size 26619, current size' "$Wc_c"
fi
exit 0
Newsgroups: fj.editor.emacs