Newsgroups: fj.editor.emacs,fj.sources
Path: galaxy.trc.rwcp.or.jp!jaist-news!cs.titech!wnoc-tyo-news!sh.wide!wnoc-kyo!kuis!kubotaj!kubotaj!kazushi
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
Message-ID: <KAZUSHI.92Dec22222821@shado.kubota.co.jp>
Sender: news@kubotaj.tt.kubota.co.jp (News System)
Nntp-Posting-Host: shado
Lines: 739
Xref: galaxy.trc.rwcp.or.jp fj.editor.emacs:3392 fj.sources:2895
X-originally-archived-at: http://galaxy.rwcp.or.jp/text/cgi-bin/newsarticle2?ng=fj.editor.emacs&nb=3392&hd=a
X-reformat-date: Mon, 18 Oct 2004 15:18:22 +0900
X-reformat-comment: Tabs were expanded into 4 column tabstops by the Galaxy's archiver. See http://katsu.watanabe.name/ancientfj/galaxy-format.html for more info.


$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~$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$+$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$+$i$J$+$C$?;~$K!"(B.Z$B$J$I$rIU$1$?%U%!%$%kL>$N%U%!%$%k$rA\$9(B
   $B$N$G$9$,!"$=$l$r9bB.2=$7$?!#(B
4. ange-ftp$B$KBP1~$7$?!#8e$+$i(Bange-ftp$B$r(Bload$B$7$F$bLdBj$J$$!#(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$+$:$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!"%3%s%W%l%9$5$l$?%U%!%$%k$r!"(B``Mule''$B$d(B
;;; ``NEmacs''$B!"(B``Emacs''$B$+$i!"IaDL$N%U%!%$%k$H$^$C$?$/0c$$$J$/%"%/%;%9$G$-(B
;;; $B$k$h$&$K$J$j$^$9!#(B
;;;
;;; $B$H$$$&$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%!%$%k$rFI$_9~$`;~$K$O!"$^$:$=$N$^$^FI$_9~(B
;;; $B$_%P%C%U%!Cf$G%"%s%3%s%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~$`;~$K$O!"%P%C%U%!Cf$G%3%s%W%l%9$7$?8e$K=q$-9~$`$H$$$C$?(B
;;; $B:n6H$r9T$C$F$$$^$9!#$=$7$F$=$N:]$K!"4A;z%3!<%I$NJQ49$dJQ49$NM^@)$b9T$C(B
;;; $B$F$$$^$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$NMWAG$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%!%$%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>$,@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$=$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<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$N(BREGEXP$B$K%^%C%A$7$?%U%!%$%kL>$N%U%!%$%k$KBP(B
;;; $B$9$kF~=PNO$r=hM}$7$^$9!#$^$?@5<0$JL>A0$O!"<B:]$NJT=8;~$N%P%C%U%!$N%b!<(B
;;; $B%I$J$I$r7hDj$9$k$?$a$KMQ$$$i$l$^$9!#(B
;;;
;;; COMPRESSPROG$B$G$O%3%s%W%l%9$9$k$?$a$KMxMQ$9$k%W%m%0%i%`L>$r!"F1MM$K(B
;;; UNCOMPRESSPROG$B$G$O%"%s%3%s%W%l%9$9$k$?$a$KMxMQ$9$k%W%m%0%i%`L>$r;XDj$7(B
;;; $B$^$9!#(BUNCOMPRESSERRORSTR$B$G$O!"%"%s%3%s%W%l%9$K<:GT$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$k0z?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$=$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$$$&%j%9(B
;;; $B%H$,$"$C$?>l9g$K$O!"(B.taz$B$H$$$&%U%!%$%kL>$G=*$o$C$F$$$k%U%!%$%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!#$=$l$r=q$-9~$`;~$K(B
;;; $B$O(Bcompress$B$rMQ$$$F%3%s%W%l%9$r9T$$=q$-9~$_$^$9!#$^$?!"(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!"<!$K(B.taz$B$r:G8e$KIU$1(B
;;; $B2C$($F(Btest.tar.taz$B$H$$$&%U%!%$%kL>$N%U%!%$%k$rC5$9$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%U%!(B
;;; $B%$%kF~=PNO$r9T$&$3$H$b$G$-$^$9!#(B
;;;
;;; $B0l1~8E$$%P!<%8%g%s$N;~$N=q$-J}$G=q$+$l$?(Bjam-zcat-filename-list$B$K$bBP1~(B
;;; $B$7$F$$$^$9$,!"(Bfind-file$B$,<:GT$7$?>l9g$K<+F08!:w$r9T$($J$/$J$j$^$9$+$i!"(B
;;; $B$3$N?7$7$$=q$-J}$rMxMQ$7$F2<$5$l$P9,$$$G$9!#(B
;;;
;;; jam-zcat-hack-ange-ftp:
;;; $B$3$N%U%i%0$rN)$F$F$*$/$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$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%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$$$?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$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$k7A<0$N%W%m%0%i%`$rMxMQ$9$k>l(B
;;; $B9g$O!"$3$l$i$N4X?t$,8F$P$l$k=gHV$r9M$($F%m!<%I$9$kI,MW$,$"$j$^$9!#$?$@(B
;;; $B$7(Bange-ftp$B$K$D$$$F$OBP1~:Q$_$G$9$+$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$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$?$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$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$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$OMQ0U$5$l$F$$$^$;(B
;;; $B$s$G$7$?!#$=$N$?$a$K!"<1JL4X?t$rFH<+$K:n@.$7$F=hM}$r9T$C$F$$$^$9!#(B
;;;
;;; **$B:G8e$K(B***
;;; $B$5$F:G8e$K$J$j$^$7$?$,!"4X?t$rCV$-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
;;;  $B8ENS5*: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$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
Xfname 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))
Xresult 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)
Xkcode))))))
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))
Xnil)
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
