home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #31 / NN_1992_31.iso / spool / fj / editor / emacs / 1347 < prev    next >
Encoding:
Internet Message Format  |  1992-12-22  |  29.1 KB
  1. Xref: sparky fj.editor.emacs:1347 fj.sources:908
  2. Newsgroups: fj.editor.emacs,fj.sources
  3. Path: sparky!uunet!stanford.edu!sun-barr!sh.wide!wnoc-kyo!kuis!kubotaj!kubotaj!kazushi
  4. From: kazushi@kubota.co.jp (Kazushi (Jam) Marukawa)
  5. Subject: jam-zcat.el-1.40
  6. Organization: Computer Development Engineering Dept., Kubota Co.
  7. Distribution: fj
  8. Date: Tue, 22 Dec 1992 13:28:18 GMT
  9. Message-ID: <KAZUSHI.92Dec22222821@shado.kubota.co.jp>
  10. Sender: news@kubotaj.tt.kubota.co.jp (News System)
  11. Nntp-Posting-Host: shado
  12. Lines: 739
  13.  
  14.  
  15. $B$I$&$b!"$+$:$7!w%/%\%?$G$9!#(B
  16.  
  17. $B$3$l$O!"(BEmacs$B!"(BNEmacs$B!"(BMule$B$+$i!"(Bcompress$B$d(Bcrypt$B$7$?%U%!%$%k$r%"%/%;%9$9$k(B
  18. $B$?$a$N%Q%C%1!<%8$G$9!#(B
  19.  
  20. $B$3$l$^$G(BMule$BBP1~(B$B$r$7$F$$$?$N$G$9$,!"$=$m$=$m$"$kDxEY$N$^$H$^$C$?JQ99$,=*$o$C(B
  21. $B$?$?$a!"(Bfj$B$NJ}$K$bEj9F$7$^$9!#(B
  22.  
  23. $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
  24.  
  25.  
  26.  **$B<g$J5!G=$K$D$$$F$NJQ99E@(B**
  27. 1. Mule$B$KBP1~$7$?!#(B
  28. 2. crypt$B$J$I$N0z?t$rI,MW$H$9$k%W%m%0%i%`$K$bBP1~$7$?!#(B
  29. 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
  30.    $B$N$G$9$,!"(B$B$=$l$r9bB.2=$7$?!#(B
  31. 4. ange-ftp$B$KBP1~$7$?!#8e$+$i(Bange-ftp$B$r(Bload$B$7$F$bLdBj$J$$(B$B!#(B
  32. 5. $B4s$;$i$l$?%P%0>pJs$KBP1~$7$?!#(B
  33.  
  34.  **$B<g$JJQ?t$K$D$$$F$NJQ99E@(B**
  35. 1. jam-zcat-filename-alist$B$N9=B$$,JQ$o$C$?!#0JA0$N=q$-J}$G$b8_49@-$O$"$k!#(B
  36.  
  37. -- $B$+(B$B$:$7(B
  38.  
  39. #!/bin/sh
  40. # This is a shell archive (produced by shar 3.49)
  41. # To extract the files from this archive, save it to a file, remove
  42. # everything above the "!/bin/sh" line above, and type "sh file_name".
  43. #
  44. # made 12/22/1992 13:22 UTC by kazushi@nekobus
  45. # Source directory /usr1/private/kazushi/lib/mule/mine
  46. #
  47. # existing files will NOT be overwritten unless -c is specified
  48. #
  49. # This shar contains:
  50. # length  mode       name
  51. # ------ ---------- ------------------------------------------
  52. #  26619 -r--r--r-- jam-zcat.el
  53. #
  54. # ============= jam-zcat.el ==============
  55. if test -f 'jam-zcat.el' -a X"$1" != X"-c"; then
  56.     echo 'x - skipping jam-zcat.el (File already exists)'
  57. else
  58. echo 'x - extracting jam-zcat.el (Text)'
  59. sed 's/^X//' << 'SHAR_EOF' > 'jam-zcat.el' &&
  60. ;; -*-Emacs-Lisp-*-
  61. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  62. ;;
  63. ;; File:         jam-zcat.el
  64. ;; RCS:          $Id: jam-zcat.el,v 1.40 1992/12/17 02:40:02 kazushi Exp $
  65. ;; Description:  simple file access through SOME PROGRAMS from GNU Emacs
  66. ;; Author:       Kazushi Jam Marukawa, kazushi@kubota.co.jp
  67. ;; Created:      Fri Jan  4 12:29:21 JST 1991
  68. ;;
  69. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  70. X
  71. ;;; Copyright (C) 1991, 1992 Kazushi Marukawa.
  72. ;;;
  73. ;;; Author: Kazushi Marukawa (kazushi@kubota.co.jp)
  74. ;;;
  75. ;;; This program is free software; you can redistribute it and/or modify
  76. ;;; it under the terms of the GNU General Public License as published by
  77. ;;; the Free Software Foundation; either version 1, or (at your option)
  78. ;;; any later version.
  79. ;;;
  80. ;;; This program is distributed in the hope that it will be useful,
  81. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  82. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  83. ;;; GNU General Public License for more details.
  84. ;;;
  85. ;;; -- Japanese Documents --
  86. ;;; $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
  87. ;;; ``NEmacs''$B!"(B``Emacs''$B$+$i!"IaDL$N%U(B$B%!%$%k$H$^$C$?$/0c$$$J$/%"%/%;%9$G$-(B
  88. ;;; $B$k$h$&$K$J$j$^$9!#(B
  89. ;;;
  90. ;;; $B$H$$(B$B$&$h$j!"9%$-$J%U%!%$%kL>$N%U%!%$%k$r9%$-$J%W%m%0%i%`$r2p$7$FF~=PNO(B
  91. ;;; $B$9$k$3$H$,$G$-$k$h$&$K$J$j$^$9!#(B
  92. ;;;
  93. ;;; $BFbIt$G$O!"%3%s%W%l%9$5$l$?%U(B$B%!%$%k$rFI$_9~$`;~$K$O!"$^$:$=$N$^$^FI$_9~(B
  94. ;;; $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
  95. ;;; $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
  96. ;;; $B:n6H$r9T$C(B$B$F$$$^$9!#$=$7$F$=$N:]$K!"4A;z%3!<%I$NJQ49$dJQ49$NM^@)$b9T$C(B
  97. ;;; $B$F$$(B$B$^$9!#(B
  98. ;;;
  99. ;;; $B@_Dj$G$-$kJQ?t$O(Bjam-zcat-filename-list$B!"(Bjam-zcat-hack-ange-ftp$B!"(B
  100. ;;; jam-zcat-hack-loadablep$B!"(Bjam-zcat-si-mode$B$G$9!#(B
  101. ;;;
  102. ;;; jam-zcat-filename-list:
  103. ;;; $B$3$N%j%9%H$N(B$BMWAG$O!"(B(((REGEXP . STRRPL) (REGEXP . STRRPL)...)
  104. ;;; COMPRESSPROG UNCOMPRESSPROG UNCOMPRESSERRORSTR [COMPRESSARG
  105. ;;; [UNCOMPRESSARG]])$B$H$$$C$?7A$r$7$F$$$^$9!#(B
  106. ;;;
  107. ;;; $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
  108. ;;; $BAH$NCf$N(BREGEXP$B$K%^%C%A$7$?>l9g$O!"%^%C%A$7$?ItJ,$r(BSTRRPL$B$GCV$-49$($?%U%!(B
  109. ;;; $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
  110. ;;; $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
  111. ;;; $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
  112. ;;; $B$JJ*$G!"$=$l$rCV$-49$($?%U%!%$%kL>$,<B:]$N(B($BNc$($P%3%s%W%l%98e$N(B)$B%U%!%$(B
  113. ;;; $B%kL>$H$7$F<h$j07$o$l$^$9!#(B
  114. ;;;
  115. ;;; $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
  116. ;;; $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
  117. ;;; $B%I$J$I$r7hDj$9$k(B$B$?$a$KMQ$$$i$l$^$9!#(B
  118. ;;;
  119. ;;; 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
  120. ;;; 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
  121. ;;; $B$^$9!#(BUNCOMPRESSERRORSTR$B$G$O!"%"%s%3%s%W%l%9$K<:GT(B$B$7$?;~$K%W%m%0%i%`$,(B
  122. ;;; $B=PNO$9$k%(%i!<%a%C%;!<%8$r;XDj$7$^$9!#(B
  123. ;;;
  124. ;;; $B$^$?!"(BCOMPRESSARG$B$H(BUNCOMPRESSARG$B$rMxMQ$7$F!"$=$l$i$N%W%m%0%i%`$GMxMQ$9(B
  125. ;;; $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
  126. ;;; $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
  127. ;;; $B$=$NBe$j$K(BCOMPRESSARG$B$rMxMQ$7$^$9!#(B
  128. ;;;
  129. ;;; $BNc$($P!"(B((("\\.taz$" . ".tar") ("\\.tar$" . ".taz") ("$" . ".taz"))
  130. ;;; "compress" "uncompress" "stdin: not in compressed format\n")$B$H(B$B$$$&%j%9(B
  131. ;;; $B%H$,$"$C$?>l9g$K$O!"(B.taz$B$H$$$&%U%!%$%kL>$G=*$o$C$F$$$k%U%!(B$B%$%k$rFI$_9~(B
  132. ;;; $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
  133. ;;; $BCV$-49$($?L>A0$rMQ$$$F%P%C%U%!$N%b!<%I$r@_Dj$7$^$9!#(B$B$=$l$r=q$-9~$`;~$K(B
  134. ;;; $B$O(Bcompress$B$rMQ$$$F%3%s%W%l%9$r9T$$=q$-9~$_$^$9!#$^(B$B$?!"(Btest.tar$B$H$$$C$?(B
  135. ;;; $B%U%!%$%kL>$rMQ$$$F(Bfind-file$B$K<:GT$7$?>l9g$K$O!"$^$:(B.tar$B$NItJ,$r(B.tar$B$GCV(B
  136. ;;; $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
  137. ;;; $B2C$($F(Btest.tar.taz$B$H$$$&%U%!%$%kL>$N%U%!%$%k$rC5$9(B$B$H$$$C$?F0:n$r9T$$$^(B
  138. ;;; $B$9!#(B
  139. ;;;
  140. ;;; $B$^$?!"(B((("\\.cry$" . "") ("" . ".cry")) "crypt" "crypt" nil
  141. ;;; (jam-zcat-get-crypt-key))$B$H$$$C$?%j%9%H$rMxMQ$9$k$H!"(Bcrypt$B$rMxMQ$7$F(B$B%U%!(B
  142. ;;; $B%$%kF~=PNO$r9T$&$3$H$b$G$-$^$9!#(B
  143. ;;;
  144. ;;; $B0l1~8E$$%P!<%8%g%s$N;~(B$B$N=q$-J}$G=q$+$l$?(Bjam-zcat-filename-list$B$K$bBP1~(B
  145. ;;; $B$7$F$$$^$9$,!"(Bfind-file$B$,<:(B$BGT$7$?>l9g$K<+F08!:w$r9T$($J$/$J$j$^$9$+$i!"(B
  146. ;;; $B$3$N?7$7$$=q$-J}$rMx(B$BMQ$7$F2<$5$l$P9,$$$G$9!#(B
  147. ;;;
  148. ;;; jam-zcat-hack-ange-ftp:
  149. ;;; $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
  150. ;;; $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
  151. ;;; $B$7$?8e$K$3$N%Q(B$B%C%1!<%8$r%m!<%I$9$kJ,$K$O2?$NLdBj$b$"$j$^$;$s!#(B
  152. ;;;
  153. ;;; jam-zcat-hack-loadablep:
  154. ;;; ``Mule''$B$K$*$$$F!"$3$N%U%i%0$rN)$F$F$*$/$H!"(Bload$B4X?t$K$*$$$F$b(B``.Z''$B$N(B
  155. ;;; $BIU$$$?(Belisp$B$N%U%!%$%k$r%m!<%I$9$k$3$H$,$G$-$k$h$&$K$J$j$^$9!#(B
  156. ;;;
  157. ;;; jam-zcat-si-mode:
  158. ;;; ``Mule''$B$K$*$$$F!"$3$N%U%i%0$rN)$F$F$*$/$H!"(B``si:''$B$,IU(B$B$$$?4X?t$rCV$-49(B
  159. ;;; $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
  160. ;;; $B$F$$$?>l9g$K$b$&$^$/F0:n$9$k$h$&$K$J$k$O$:$G$9!#(B
  161. ;;;
  162. ;;; **$BCm0UE@(B**
  163. ;;; $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
  164. ;;; $B$^$9!#(B
  165. ;;;
  166. ;;; NEmacs$B$d!"(BEmacs$B$N>l9g(B:
  167. ;;;   write-region
  168. ;;;   insert-file-contents
  169. ;;;   normal-mode
  170. ;;;   get-file-buffer
  171. ;;;
  172. ;;; Mule$B$N>l9g(B:
  173. ;;;   si:write-region$B$+(Bwrite-region
  174. ;;;   si:insert-file-contents$B$+(Binsert-file-contents
  175. ;;;   normal-mode
  176. ;;;   get-file-buffer
  177. ;;;   loadablep
  178. ;;;
  179. ;;; $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
  180. ;;; $B9g$O!"$3$l$i$N4X?t$,8F$P$l$k=gHV$r(B$B9M$($F%m!<%I$9$kI,MW$,$"$j$^$9!#$?$@(B
  181. ;;; $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
  182. ;;; $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
  183. ;;;
  184. ;;; **$B8=:_$NLdBjE@(B**
  185. ;;; NEMACS$B$N>l9g(B:
  186. ;;; callproc.c$BCf$N(Bcall-process-region$B4X?t$G(Bkanji-flag$B$N%A%'%C%/$r$7$F$$$J$$(B
  187. ;;; $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
  188. ;;; $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
  189. ;;; $B$,9T$o$l$k4m81$,$"$j$^$9!#I8=`$N(BNemacs$B$G;H$o$l$F$$$k$J$iBg>fIW$G$9$,!#(B
  190. ;;;
  191. ;;; $BI8=`$N(Bfind-kanji-file-output-code$BEy$G$O%"%Z%s%I;~$N4A;z%3!<%I%A%'%C%/$r(B
  192. ;;; $BFC$K9T$J$C$F$$$^$;$s!#$=$N$?$a%"%Z%s%I$9$k$?$a$K(Bwrite-region$B$rMxMQ$9(B$B$k(B
  193. ;;; $B$H!"$=$N%U%!%$%k$N4A;z%3!<%I$,JQ$o$C$F$7$^$&$3$H$,$"$j$^$9!#(B
  194. ;;;
  195. ;;; MULE$B$N>l9g(B:
  196. ;;; $BI8=`E*$J4A;z%3!<%I<1JL4X?t$,!"8E$$%P!<%8%g%s$N(BMULE$B$G(B$B$OMQ0U$5$l$F$$$^$;(B
  197. ;;; $B$s$G$7$?!#$=$N$?$a$K!"<1JL4X?t$rFH<+$K:n@.$7$F(B$B=hM}$r9T$C$F$$$^$9!#(B
  198. ;;;
  199. ;;; **$B:G8e$K(B***
  200. ;;; $B$5$F:G8e$K$J$j$^$7$?$,!"4X?t$r(B$BCV$-49$($k$H$$$&%"%$%G%#%"$H!"$=$N4J7i$J(B
  201. ;;; $BJ}K!$,5-=R$5$l$F$$$k!"(B`ange-ftp.el(by ange@hplb.hpl.hp.com)$B$,BgJQ;29M$K(B
  202. ;;; $B$J$C$F$$$^$9!#46<U$7$^$9!#(B
  203. ;;;
  204. ;;; $B$^$?0J2<$N%P%0$N;XE&$d=u8@$rM?$($F$/$l$?J}!9$K$b46<U$7$^$9!#(B
  205. ;;;  $B8E(B$BNS5*:H(B Noriya KOBAYASHI :<nk@ics.osaka-u.ac.jp>
  206. ;;;  $BKYFbJ]=((B Horiuchi Yasuhide:<homy@cs.titech.ac.jp>
  207. ;;;  $BFj:j=$Fs(B NARAZAKI Shuji   :<narazaki@nttslb.ntt.jp>
  208. ;;;  $B9-@n0lIW(B Kazuo Hirokawa   :<hirokawa@rics.co.jp>
  209. ;;;
  210. ;;; $B2?$+LdBj$,$"$j$^$7$?$i!"(Bkazushi@kubota.co.jp$B$^$G$*CN(B$B$i$;2<$5$$!#(B
  211. ;;;
  212. X
  213. ;;; Variable which can be set by USER.
  214. ;;;
  215. (defvar jam-zcat-filename-list
  216. X  '(((("\\.Z$" . "") ("$" . ".Z")) "compress" "uncompress"
  217. X     "stdin: not in compressed format\n")
  218. X    ((("\\.taz$" . ".tar") ("\\.tar$" . ".taz") ("$" . ".taz"))
  219. X     "compress" "uncompress"
  220. X     "stdin: not in compressed format\n")
  221. X    ((("\\.Y$" . "") ("$" . ".Y")) "yabba" "unyabba"
  222. X     "unyabba: fatal: input not in right format\n"))
  223. X  " Each element looks like (((REGEXP . STRRPL) (REGEXP . STRRPL)...)
  224. COMPRESSPROG UNCOMPRESSPROG UNCOMPRESSERRORSTR [COMPRESSARG [UNCOMPRESSARG]]).
  225. X
  226. X Reading a file whose name matches first REGEXP cause uncompress it and
  227. choose major mode from real-filename that is created replacing matched area
  228. to first STRRPL.  If file not found, search compressed file with
  229. substituted file name by rest (REGEXP . STRRPL)s.
  230. X
  231. X COMPRESSPROG is compressing program name, UNCOMPRESSPROG is uncompressing
  232. program name.  UNCOMPRESSERRORSTR is error string when uncompressing.
  233. Each of these 3 argument must be a string.
  234. X
  235. X When compressing, COMPRESSARG is evaluated and use result as a argument
  236. list for compressing.  UNCOMPRESSARG is evaluated when uncompressing, but
  237. if there is no UNCOMPRESSARG, COMPRESSARG is used as UNCOMPRESSARG.
  238. X
  239. X Note for old version:
  240. X Each element of old version looks like ((REGEXP . STRRPL) COMPRESSPROG
  241. UNCOMPRESSPROG UNCOMPRESSERRORSTR).  And it supported.")
  242. X
  243. (defvar jam-zcat-hack-ange-ftp t
  244. X  "Non nil means hack to get real filename when using the ange-ftp.")
  245. X
  246. (defvar jam-zcat-hack-loadablep t
  247. X  "On the Mule, non nil means hack to load compressed file.")
  248. X
  249. (defvar jam-zcat-si-mode t
  250. X  "On the Mule, non nil means that this package patch to
  251. si:insert-file-contents and si:write-region.")
  252. X
  253. ;;; Internal variables.
  254. ;;;
  255. (defvar jam-zcat-how-to-list nil
  256. X  "Current one of jam-zcat-filename-list.")
  257. X
  258. ;;; Internal routines.
  259. ;;;
  260. (defun jam-zcat-error-p ()
  261. X  "Check a uncompress program's error message."
  262. X  (let ((sexp (nth 3 jam-zcat-how-to-list)))
  263. X    (cond ((stringp sexp)
  264. X       (string= (buffer-substring
  265. X             (point-min)
  266. X             (min (point-max) (+ (point-min) (length sexp))))
  267. X            sexp))
  268. X      (sexp (eval sexp)))))
  269. X
  270. (defun jam-zcat-substitute-string (str slist)
  271. X  "Return substituted string for STRING.  Replaces matched text by regular
  272. expression of (car SLIST) with (cdr SLIST)."
  273. X  (if (string-match (car slist) str)
  274. X      (concat (substring str 0 (match-beginning 0))
  275. X          (cdr slist)
  276. X          (substring str (match-end 0) nil))))
  277. X
  278. (defun jam-zcat-filename-to-realname (fname)
  279. X  "Convert FILENAME to real filename, if it was compressed."
  280. X  (and (stringp fname)
  281. X       (let ((case-fold-search (eq system-type 'vax-vms)))
  282. X     (catch 'exit
  283. X       (mapcar (function
  284. X            (lambda (how-to)
  285. X              (let* ((name-conv (if (stringp (car (car how-to)))
  286. X                        (car how-to)
  287. X                      (car (car how-to))))
  288. X                 (realname (jam-zcat-substitute-string
  289. X                    fname name-conv)))
  290. X            (if realname
  291. X                (progn
  292. X                  (setq jam-zcat-how-to-list how-to)
  293. X                  (throw 'exit realname))))))
  294. X           jam-zcat-filename-list)
  295. X       fname))))
  296. X
  297. (defmacro jam-zcat-localize-code (&optional MULE-CODE NEMACS-CODE EMACS-CODE)
  298. X  "If this called on Mule, eval MULE-CODE.  If on NEmacs, eval NEMACS-CODE.
  299. Otherwise eval EMACS-CODE or NEMACS-CODE(if EMACS-CODE is nil)."
  300. X  (cond ((boundp 'MULE) MULE-CODE)
  301. X    ((boundp 'NEMACS) NEMACS-CODE)
  302. X    (t (if EMACS-CODE EMACS-CODE NEMACS-CODE))))
  303. X
  304. (defun jam-zcat-read-string-no-echo (prompt &optional default)
  305. X  "Read a string from the user. Echos a . for each character typed.
  306. End with RET, LFD, or ESC. DEL or C-h rubs out.  ^U kills line.
  307. Optional DEFAULT is string to start with."
  308. X  (let ((str (if default default ""))
  309. X    (c 0)
  310. X    (echo-keystrokes 0)
  311. X    (cursor-in-echo-area t))
  312. X    (while (and (/= c ?\r) (/= c ?\n) (/= c ?\e))
  313. X      (message "%s%s"
  314. X           prompt
  315. X           (make-string (length str) ?.))
  316. X      (setq c (read-char))
  317. X      (if (= c ?\C-u)
  318. X      (setq str "")
  319. X    (if (and (/= c ?\b) (/= c ?\177))
  320. X        (setq str (concat str (char-to-string c)))
  321. X      (if (> (length str) 0)
  322. X          (setq str (substring str 0 -1))))))
  323. X    (message "")
  324. X    (substring str 0 -1)))
  325. X
  326. (defun jam-zcat-get-crypt-key ()
  327. X  (if (and (boundp 'crypt-key) crypt-key)
  328. X      crypt-key
  329. X    (make-variable-buffer-local 'crypt-key)
  330. X    (setq crypt-key (list (jam-zcat-read-string-no-echo
  331. X               "Set key for cryptogram: ")))
  332. X    crypt-key))
  333. X
  334. (jam-zcat-localize-code
  335. X (defun code-detect-like-fileio (start end)
  336. X   "Detect kanji code of buffer string with algolithm like original
  337. insert-file-contents function."
  338. X   (let ((code (code-detect-region start end 1)))
  339. X     (cond ((equal code (get '*internal-code-category* 'code-priority-value))
  340. X        *internal*)
  341. X       ((equal code (get '*sjis-code-category* 'code-priority-value))
  342. X        *sjis*)
  343. X       ((equal code (get '*junet-code-category* 'code-priority-value))
  344. X        *junet*)
  345. X       ((equal code (get '*euc-code-category* 'code-priority-value))
  346. X        *euc-japan*)
  347. X       ((equal code (get '*ctext-code-category* 'code-priority-value))
  348. X        *ctext*)
  349. X       ((equal code (get '*big5-code-category* 'code-priority-value))
  350. X        *big5-hku*)))))
  351. X
  352. ;;; Routines will replease original one.
  353. ;;;
  354. (defun jam-zcat-insert-file-contents (filename &optional visit &rest code)
  355. X  "Documented as original."
  356. X  (barf-if-buffer-read-only)
  357. X  (setq filename (expand-file-name filename))
  358. X  (let ((realname (jam-zcat-filename-to-realname filename))
  359. X    (realfilename filename)
  360. X    (modp (buffer-modified-p))
  361. X    result result-code)
  362. X    ;; Support Ange-ftp
  363. X    (if (and (fboundp 'ange-ftp-insert-file-contents) jam-zcat-hack-ange-ftp
  364. X         (boundp 'parsed) parsed
  365. X         (boundp 'path) (stringp path))
  366. X    ;; now be called through ange-ftp, hack it!
  367. X    (progn
  368. X      (setq realname (jam-zcat-filename-to-realname path))
  369. X      (setq realfilename path)))
  370. X    (if (string= realname realfilename)
  371. X    (apply 'jam-zcat-real-insert-file-contents filename visit code)
  372. X      (setq result            ; READ file without any conversion
  373. X        (jam-zcat-localize-code
  374. X         (if code
  375. X         (cdr (jam-zcat-real-insert-file-contents filename
  376. X                              visit *noconv*))
  377. X           (let ((file-coding-system-for-read *noconv*)
  378. X             file-coding-system)
  379. X         (jam-zcat-real-insert-file-contents filename visit)))
  380. X         (let (kanji-flag)
  381. X           (jam-zcat-real-insert-file-contents filename visit))))
  382. X      (save-excursion
  383. X    (save-restriction
  384. X      (narrow-to-region (point) (+ (point) (nth 1 result)))
  385. X                    ; UNCOMPRESS without kanji code conv.
  386. X      (message "Uncompressing %s ..." realfilename)
  387. X      (condition-case err
  388. X          (progn
  389. X        (let ((args (eval (or (nth 5 jam-zcat-how-to-list)
  390. X                      (nth 4 jam-zcat-how-to-list)))))
  391. X          (jam-zcat-localize-code
  392. X           (let ((default-process-coding-system
  393. X               (cons *noconv* *noconv*))
  394. X             (kill-it
  395. X              (not (local-file-coding-system-p))) ; for Mule BUG
  396. X             process-connection-type
  397. X             mc-flag)
  398. X             (apply 'call-process-region (point) (point-max)
  399. X                (nth 2 jam-zcat-how-to-list) t t nil args)
  400. X             (if kill-it
  401. X             (kill-local-variable 'file-coding-system)))
  402. X           (let (kanji-flag
  403. X             default-kanji-process-code
  404. X             service-kanji-code-alist
  405. X             program-kanji-code-alist
  406. X             process-connection-type)
  407. X             (apply 'call-process-region (point) (point-max)
  408. X                (nth 2 jam-zcat-how-to-list) t t nil args))))
  409. X        (if (jam-zcat-error-p)
  410. X            (signal 'file-error
  411. X                (list
  412. X                 "Uncompressing input file"
  413. X                 (format "Unable to %s input file"
  414. X                     (upcase (nth 2 jam-zcat-how-to-list)))
  415. X                 realfilename))))
  416. X        (file-error
  417. X         (cond ((not visit)
  418. X            (delete-region (point-min) (point-max))
  419. X            (set-buffer-modified-p modp))
  420. X           (t
  421. X            (set-buffer-modified-p modp)
  422. X            (kill-buffer (current-buffer))))
  423. X         (apply 'error "%s: %s, %s" (cdr err))))
  424. X      (message "Uncompressing %s ... done" realfilename)
  425. X      (jam-zcat-localize-code    ; CONVERT kanji code
  426. X       (if mc-flag
  427. X           (let ((code (cond ((or (null (nth 0 code))
  428. X                      (equal (nth 0 code) *autoconv*))
  429. X                  (code-detect-like-fileio (point-min)
  430. X                               (point-max)))
  431. X                 (t (nth 0 code)))))
  432. X         (setq result-code code)
  433. X         (if code (code-convert-region (point-min) (point-max)
  434. X                           code *internal*))))
  435. X       (if (and (boundp 'kanji-flag) kanji-flag)
  436. X           (let ((code (invoke-find-kanji-file-input-code
  437. X                realname visit (point-min) (point-max))))
  438. X         (if (or (eq code 1) (eq code 2))
  439. X             (progn
  440. X               (convert-region-kanji-code (point-min) (point-max)
  441. X                          code 3))))))
  442. X      (if visit
  443. X          (set-buffer-modified-p modp))))
  444. X      (if code
  445. X      (list result-code (car result) (point-max))
  446. X    (jam-zcat-localize-code
  447. X     (if (not file-coding-system)    ; On Mule, now CHANGE buffer kanji code
  448. X
  449. X         (set-file-coding-system result-code))
  450. X                    ; On NEmacs, CHANGED buffer kanji code
  451. X                    ; at invoke-find-kanji-file-input-code
  452. X     )
  453. X    (list (car result) (point-max))))))
  454. X
  455. (defun jam-zcat-normal-mode (&optional find-file)
  456. X  "Documented as original."
  457. X  (let ((buffer-file-name (jam-zcat-filename-to-realname buffer-file-name)))
  458. X    (jam-zcat-real-normal-mode find-file)))
  459. X
  460. (defun jam-zcat-write-region (start end filename &optional append visit
  461. X                    &rest code)
  462. X  "Documented as original."
  463. X  (interactive "r\nFWrite region to file: ")
  464. X  (setq filename (expand-file-name filename))
  465. X  (let ((realname (jam-zcat-filename-to-realname filename))
  466. X    (realfilename filename))
  467. X    ;; Support Ange-ftp
  468. X    (if (and (fboundp 'ange-ftp-insert-file-contents) jam-zcat-hack-ange-ftp
  469. X         (boundp 'parsed) parsed
  470. X         (boundp 'path) (stringp path))
  471. X    ;; now be called through ange-ftp, hack it!
  472. X    (progn
  473. X      (setq realname (jam-zcat-filename-to-realname path))
  474. X      (setq realfilename path)))
  475. X    (if (string-equal realname realfilename)
  476. X    (apply 'jam-zcat-real-write-region start end filename append visit
  477. X           code)
  478. X      (let ((temp (get-buffer-create "*compress*"))
  479. X        (cbuf (current-buffer))
  480. X        (save-start (make-marker))
  481. X        kcode)
  482. X    (save-restriction
  483. X      (narrow-to-region start end)
  484. X      (cond ((not append)
  485. X         (setq kcode        ; GET kanji code for conv.
  486. X               (jam-zcat-localize-code
  487. X            (if mc-flag
  488. X                (or (nth 0 code)
  489. X                (if (and current-prefix-arg (interactive-p))
  490. X                    (read-coding-system "Coding-system: ")
  491. X                  file-coding-system)))
  492. X            (if (and (boundp 'kanji-flag) kanji-flag)
  493. X                (invoke-find-kanji-file-output-code
  494. X                 start end realname append visit))))
  495. X         (set-buffer temp)
  496. X         (erase-buffer))
  497. X        (t
  498. X         (set-buffer temp)
  499. X         (erase-buffer)
  500. X                    ; READ target file
  501. X         (insert-file-contents filename nil)
  502. X         (setq kcode        ; GET kanji code of target file
  503. X               (jam-zcat-localize-code
  504. X            (if mc-flag
  505. X                (or file-coding-system kcode))
  506. X            (if (and (boundp 'kanji-flag) kanji-flag)
  507. X                (or (invoke-find-kanji-file-output-code
  508. X                 start end realname append visit)
  509. X                kcode))))))
  510. X      (goto-char (point-max))
  511. X      (insert-buffer cbuf)
  512. X      (jam-zcat-localize-code
  513. X       nil                ; On Mule, will CONVERT it at
  514. X                    ; call-process-region
  515. X                    ; On NEmacs, CONVERT kanji code
  516. X       (if (or (eq kcode 1) (eq kcode 2))
  517. X           (convert-region-kanji-code (point-min) (point-max)
  518. X                      3 kcode)))
  519. X      (unwind-protect
  520. X          (progn
  521. X        (condition-case err
  522. X            (progn        ; COMPRESS without/with kanji code
  523. X                    ; conv.
  524. X              (message "Compressing %s ..." realfilename)
  525. X              (let ((args (prog2
  526. X                   (set-buffer cbuf)
  527. X                   (eval (nth 4 jam-zcat-how-to-list))
  528. X                   (set-buffer temp))))
  529. X            (jam-zcat-localize-code
  530. X             (let ((default-process-coding-system
  531. X                 (cons *noconv* kcode))
  532. X                   process-connection-type)
  533. X               (apply 'call-process-region (point-min) (point-max)
  534. X                  (nth 1 jam-zcat-how-to-list) t t nil args))
  535. X             (let (kanji-flag
  536. X                   default-kanji-process-code
  537. X                   service-kanji-code-alist
  538. X                   program-kanji-code-alist
  539. X                   process-connection-type)
  540. X               (apply 'call-process-region (point-min) (point-max)
  541. X                  (nth 1 jam-zcat-how-to-list) t t nil args))))
  542. X              (message "Compressing %s ...done" realfilename))
  543. X          (file-error
  544. X           (apply 'error "%s: %s, %s" (cdr err))))
  545. X        (if (eq visit t)
  546. X            (progn
  547. X              (set-buffer cbuf)
  548. X              (let (buffer-read-only)
  549. X            (set-marker save-start (point))
  550. X            (insert-buffer-substring temp)))
  551. X          (set-marker save-start (point-min)))
  552. X        (jam-zcat-localize-code    ; WRITE file without any conversion
  553. X         (if code
  554. X             (let (mc-flag selective-display)
  555. X               (jam-zcat-real-write-region save-start (point) filename
  556. X                           nil visit *noconv*))
  557. X           (let ((file-coding-system *noconv*) mc-flag
  558. X             selective-display)
  559. X             (jam-zcat-real-write-region save-start (point)
  560. X                         filename nil visit)))
  561. X         (let (kanji-flag selective-display)
  562. X           (jam-zcat-real-write-region save-start (point)
  563. X                           filename nil visit)))
  564. X        (if (eq visit t)
  565. X            (let (buffer-read-only)
  566. X              (delete-region save-start (point))
  567. X              (set-buffer-modified-p nil))
  568. X          (set-buffer cbuf))
  569. X        nil)
  570. X        (kill-buffer temp))
  571. X      )))))
  572. X
  573. (defun jam-zcat-get-file-buffer (filename)
  574. X  "Documented as original."
  575. X  (setq filename (expand-file-name filename))
  576. X  (or (jam-zcat-real-get-file-buffer filename)
  577. X      (if (file-exists-p filename)
  578. X      nil
  579. X    (catch 'exit
  580. X      (mapcar (function
  581. X           (lambda (buf)
  582. X             (if (string= (jam-zcat-filename-to-realname
  583. X                   (buffer-file-name buf)) filename)
  584. X             (throw 'exit buf))))
  585. X          (buffer-list))
  586. X      nil))))
  587. X
  588. (defun jam-zcat-loadablep (str &optional nosuffix)
  589. X  "Documented as original."
  590. X  (if (not jam-zcat-hack-loadablep)
  591. X      (jam-zcat-real-loadablep str nosuffix)
  592. X    (catch 'exit
  593. X      (mapcar
  594. X       '(lambda (dir)
  595. X      (let ((file (expand-file-name str dir)))
  596. X        (mapcar
  597. X         '(lambda (ext)
  598. X        (if (file-readable-p (concat file ext))
  599. X            (throw 'exit (concat file ext))))
  600. X         (if nosuffix
  601. X         '(nil)
  602. X           '(".elc" ".el" ".elc.Z" ".el.Z")))))
  603. X       load-path)
  604. X      nil)))
  605. X
  606. ;;; Routines to replace.
  607. ;;;   Original cames from ange-ftp v4.20
  608. ;;;
  609. (defvar jam-zcat-overwrite-msg
  610. X  "Note: This function has been extended to deal with compressed file.")
  611. X
  612. (defun jam-zcat-safe-documentation (fun)
  613. X  "A documentation function that isn't quite as fragile."
  614. X  (condition-case ()
  615. X      (documentation fun)
  616. X    (error nil)))
  617. X
  618. (defun jam-zcat-overwrite-fn (fun)
  619. X  "Replace FUN's function definition with jam-zcat-FUN's, saving the
  620. original definition as jam-zcat-real-FUN.  The original documentation is
  621. placed on the new definition suitably augmented."
  622. X  (let* ((name (symbol-name fun))
  623. X     (saved (intern (concat "jam-zcat-real-" name)))
  624. X     (new (intern (concat "jam-zcat-" name)))
  625. X     (nfun (symbol-function new))
  626. X     (exec-directory (if (or (equal (nth 3 command-line-args) "dump")
  627. X                 (equal (nth 4 command-line-args) "dump"))
  628. X                 "../etc/"
  629. X               exec-directory)))             
  630. X    
  631. X    ;; *** This is unnecessary for any jam-zcat function (I think):
  632. X    (while (symbolp nfun)
  633. X      (setq nfun (symbol-function nfun)))
  634. X    
  635. X    ;; Interpose the jam-zcat function between the function symbol and the
  636. X    ;; original definition of the function symbol AT TIME OF FIRST LOAD.
  637. X    ;; We must only redefine the symbol-function of FUN the very first
  638. X    ;; time, to avoid blowing away stuff that overloads FUN after this.
  639. X    
  640. X    ;; We direct the function symbol to the jam-zcat's function symbol
  641. X    ;; rather than function definition to allow reloading of this file or
  642. X    ;; redefining of the individual function (e.g., during debugging)
  643. X    ;; later after some other code has been loaded on top of our stuff.
  644. X    
  645. X    (or (fboundp saved)
  646. X    (progn
  647. X      (fset saved (symbol-function fun))
  648. X      (fset fun new)))
  649. X    
  650. X    ;; Rewrite the doc string on the new jam-zcat function.  This should
  651. X    ;; be done every time the file is loaded (or a function is redefined),
  652. X    ;; because the underlying overloaded function may have changed its doc
  653. X    ;; string.
  654. X    
  655. X    (let* ((doc-str (jam-zcat-safe-documentation saved))
  656. X       (ndoc-str (concat doc-str (and doc-str "\n")
  657. X                 jam-zcat-overwrite-msg)))
  658. X      
  659. X      (cond ((listp nfun)
  660. X         ;; Probe to test whether function is in preloaded read-only
  661. X         ;; memory, and if so make writable copy:
  662. X         (condition-case nil
  663. X         (setcar nfun (car nfun))
  664. X           (error
  665. X        (setq nfun (copy-sequence nfun)) ; shallow copy only
  666. X        (fset new nfun)))
  667. X         (let ((ndoc-cdr (nthcdr 2 nfun)))
  668. X           (if (stringp (car ndoc-cdr))
  669. X           ;; Replace the existing docstring.
  670. X           (setcar ndoc-cdr ndoc-str)
  671. X         ;; There is no docstring.  Insert the overwrite msg.
  672. X         (setcdr ndoc-cdr (cons (car ndoc-cdr) (cdr ndoc-cdr)))
  673. X         (setcar ndoc-cdr jam-zcat-overwrite-msg))))
  674. X        (t
  675. X         ;; it's an emacs19 compiled-code object
  676. X         (let ((new-code (append nfun nil))) ; turn it into a list
  677. X           (if (nthcdr 4 new-code)
  678. X           (setcar (nthcdr 4 new-code) ndoc-str)
  679. X         (setcdr (nthcdr 3 new-code) (cons ndoc-str nil)))
  680. X           (fset new (apply 'make-byte-code new-code))))))))
  681. X
  682. (jam-zcat-localize-code
  683. X (cond (jam-zcat-si-mode
  684. X    (fset 'jam-zcat-si:insert-file-contents
  685. X          (symbol-function 'jam-zcat-insert-file-contents))
  686. X    (jam-zcat-overwrite-fn 'si:insert-file-contents)
  687. X    (fset 'jam-zcat-real-insert-file-contents
  688. X          (symbol-function 'jam-zcat-real-si:insert-file-contents))
  689. X    (fset 'jam-zcat-si:write-region
  690. X          (symbol-function 'jam-zcat-write-region))
  691. X    (jam-zcat-overwrite-fn 'si:write-region)
  692. X    (fset 'jam-zcat-real-write-region
  693. X          (symbol-function 'jam-zcat-real-si:write-region))
  694. X    (jam-zcat-overwrite-fn 'loadablep))
  695. X       (t
  696. X    (jam-zcat-overwrite-fn 'insert-file-contents)
  697. X    (jam-zcat-overwrite-fn 'write-region)))
  698. X (progn
  699. X   (jam-zcat-overwrite-fn 'insert-file-contents)
  700. X   (jam-zcat-overwrite-fn 'write-region)))
  701. (jam-zcat-overwrite-fn 'normal-mode)
  702. (jam-zcat-overwrite-fn 'get-file-buffer)
  703. X
  704. ;;; Routines for hook.
  705. ;;;
  706. (defun jam-zcat-search-compressed-file (name)
  707. X  (catch 'exit
  708. X    (mapcar (function
  709. X         (lambda (how-to)
  710. X           (if (consp (cdr (car how-to)))
  711. X           (mapcar (function
  712. X                (lambda (rev-name-conv)
  713. X                  (let ((fname (jam-zcat-substitute-string
  714. X                        name rev-name-conv)))
  715. X                (if (and fname
  716. X                     (file-exists-p fname))
  717. X                    (throw 'exit fname)))))
  718. X               (cdr (car how-to))))
  719. X           nil))
  720. X        jam-zcat-filename-list)
  721. X      nil))
  722. X
  723. (defun jam-zcat-find-file-not-found-hook ()
  724. X  " Called when a find-file command has not been able to find the specfied
  725. file. Read and uncompress when a compressed file exists."
  726. X  (if (string= (jam-zcat-filename-to-realname buffer-file-name)
  727. X           buffer-file-name)
  728. X      (let ((compressed-file (jam-zcat-search-compressed-file
  729. X                  buffer-file-name)))
  730. X    (if compressed-file
  731. X        (progn
  732. X          (setq buffer-file-name compressed-file)
  733. X          (insert-file-contents compressed-file t)
  734. X          (setq error nil)
  735. X          t)))))
  736. X
  737. (or (memq 'jam-zcat-find-file-not-found-hook find-file-not-found-hooks)
  738. X    (setq find-file-not-found-hooks
  739. X      (cons 'jam-zcat-find-file-not-found-hook find-file-not-found-hooks)))
  740. X
  741. ;;; Other stuff
  742. ;;;
  743. (provide 'jam-zcat)
  744. (run-hooks 'jam-zcat-load-hook)
  745. SHAR_EOF
  746. chmod 0444 jam-zcat.el ||
  747. echo 'restore of jam-zcat.el failed'
  748. Wc_c="`wc -c < 'jam-zcat.el'`"
  749. test 26619 -eq "$Wc_c" ||
  750.     echo 'jam-zcat.el: original size 26619, current size' "$Wc_c"
  751. fi
  752. exit 0
  753.