(FILECREATED "12-AUG-84 13:12:04" {ATSUGI}<JLISP>UEDA>JLISTFILES.;13
 4925   

      changes to:  (ADVICE MAKEINTERPRESS)
		   (VARS JLISTFILESCOMS)
		   (FNS PostIP)

      previous date: " 6-AUG-84 15:40:40" {ATSUGI}<JLISP>UEDA>JLISTFILES.;9)


(* Copyright (c) 1984 by Fuji Xerox Co. Ltd. - All rights reverved.)

(PRETTYCOMPRINT JLISTFILESCOMS)

(RPAQQ JLISTFILESCOMS
 ((FNS ContainJCharp EncodeCES PostIP)
		       (ALISTS (FONTDEFS JPRINT))
		       (VARS DEFAULTFONTPROFILE)
		       (MACROS JCHARP JISIFY)
		       (ADVISE MAKEINTERPRESS)))
(DEFINEQ

(ContainJCharp

  [LAMBDA (FILE)                                             (* ryu "18-JUL-84 16:54")

    (bind
 (CH ← NIL) until
 (JCHARP
 CH)
       first
 (SETQ FILE (OPENFILE FILE 'INPUT))
	     (SETQ FILE (GETSTREAM FILE))
	     [WHENCLOSE FILE 'EOF (FUNCTION (LAMBDA (X)
			    (CLOSEF X)
			    (RETFROM 'ContainJCharp NIL]
       finally
 (CLOSEF FILE)
	       (RETURN T)
       do
 (SETQ CH (READC FILE])

(EncodeCES

  [LAMBDA (JISFILE CESFILE)                                  (* ryu "18-JUL-84 17:38")

    (while
 T bind
 CH (CHSET ←(CHARACTER 0))
		  (STATE ← 'RESET)
       first
 (SETQ JISFILE (OPENFILE JISFILE 'INPUT))
	     (SETQ CESFILE (OPENFILE CESFILE 'OUTPUT))
	     [WHENCLOSE JISFILE 'EOF (FUNCTION (LAMBDA (X)
			    (CLOSEF X)
			    (CLOSEF CESFILE)
			    (RETFROM 'EncodeCES CESFILE]
       do
 (SETQ CH (READC JISFILE))
	  (SELECTQ STATE
		   (J2 [COND
			 ((JCHARP
 CH)
			   (PRIN1 (JISIFY
 CH)
				  CESFILE))
			 (T (PRIN1 (CHARACTER 255)
				   CESFILE)
			    (PRIN1 (CHARACTER 0)
				   CESFILE)
			    (PRIN1 CH CESFILE)
			    (SETQ CHSET (CHARACTER 0]
		       (SETQ STATE 'RESET))
		   (COND
		     ((JCHARP
 CH)
		       (COND
			 ((NEQ CH CHSET)
			   (PRIN1 (CHARACTER 255)
				  CESFILE)
			   (PRIN1 (JISIFY
 CH)
				  CESFILE)
			   (SETQ CHSET CH)))
		       (SETQ STATE 'J2))
		     (T [COND
			  ((NEQ CHSET (CHARACTER 0))
			    (PRIN1 (CHARACTER 255)
				   CESFILE)
			    (PRIN1 (CHARACTER 0)
				   CESFILE)
			    (SETQ CHSET (CHARACTER 0]
			(PRIN1 CH CESFILE])

(PostIP

  [LAMBDA (IPFILE)                                           (* ryu "12-AUG-84 11:03")

    (bind
 CH (CHSET ←(CHARACTER 0))
	  (KANA ←(CHARACTER 36))
	  (MADUMMY ←(CHARACTER 173))
	  (MIDUMMY ←(CHARACTER 172))
	  (MAREAL ←(CHARACTER 94))
	  (MIREAL ←(CHARACTER 95))
	  (FF ←(CHARACTER 255))
	  (FILEPTR ← 0)
       first
 (SETQ IPFILE (OPENFILE IPFILE 'BOTH))
	     [WHENCLOSE IPFILE 'EOF (FUNCTION (LAMBDA (X)
			    (CLOSEF X)
			    (RETFROM 'PostIP IPFILE]
       do
 (SETFILEPTR IPFILE FILEPTR)
	  (SETQ CH (READC IPFILE))
	  (COND
	    ((AND (EQ CHSET KANA)
		  (EQ CH MADUMMY))
	      (SETFILEPTR IPFILE FILEPTR)
	      (PRIN1 MAREAL IPFILE))
	    ((AND (EQ CHSET KANA)
		  (EQ CH MIDUMMY))
	      (SETFILEPTR IPFILE FILEPTR)
	      (PRIN1 MIREAL IPFILE))
	    ((EQ CH FF)
	      (SETQ FILEPTR (ADD1 FILEPTR))
	      (SETQ CH (READC IPFILE))
	      (SETQ CHSET CH)))
	  (SETQ FILEPTR (ADD1 FILEPTR])
)

(ADDTOVAR FONTDEFS
 (JPRINT (FONTCHANGEFLG . ALL)
			   (FILELINELENGTH . 90)
			   (COMMENTLINELENGTH 116 . 126)
			   (FIRSTCOL . 60)
			   (PRETTYLCOM . 25)
			   (FONTPROFILE (DEFAULTFONT 1 (GACHA 10)
						     (GACHA 8)
						     (MODERN 8 MRR))
					(BOLDFONT 2 (HELVETICA 10 BRR)
						  (HELVETICA 8 BRR)
						  (MODERN 8 MRR))
					(LITTLEFONT 3 (HELVETICA 8)
						    (HELVETICA 6 MIR)
						    (CLASSIC 8 MRR))
					(BIGFONT 4 (HELVETICA 12 BRR)
						 (HELVETICA 10 BRR)
						 (MODERN 10 MRR))
					(USERFONT BOLDFONT)
					(COMMENTFONT LITTLEFONT)
					(LAMBDAFONT BIGFONT)
					(SYSTEMFONT)
					(CLISPFONT BOLDFONT)
					(CHANGEFONT)
					(PRETTYCOMFONT BOLDFONT)
					(FONT1 DEFAULTFONT)
					(FONT2 BOLDFONT)
					(FONT3 LITTLEFONT)
					(FONT4 BIGFONT)
					(FONT5 5 (HELVETICA 10 BIR)
					       (HELVETICA 8 BIR)
					       (MODERN 8 MRR))
					(FONT6 6 (HELVETICA 10 BRR)
					       (HELVETICA 8 BRR)
					       (MODERN 8 MRR))
					(FONT7 7 (GACHA 10)
					       (GACHA 8)
					       (MODERN 8 MRR)))
			   (FONTESCAPECHAR . %)))

(RPAQQ DEFAULTFONTPROFILE
 STANDARD)
(DECLARE: EVAL@COMPILE 

(PUTPROPS JCHARP MACRO
 [(CH)
			(NOT (ZEROP (LOGAND (CHCON1 CH)
					    128])

(PUTPROPS JISIFY MACRO
 ((CH)
			(CHARACTER (LOGAND (CHCON1 CH)
					   127))))
)

(PUTPROPS MAKEINTERPRESS READVICE
 [NIL (AROUND NIL (COND [(ContainJCharp FILE)
							  (RESETLST (RESETSAVE NIL
									       (LIST 'FONTSET 
									       DEFAULTFONTPROFILE))
								    (SETQ FILE (EncodeCES
									    FILE
									    '{CORE}JPRINT.SCRATCH))
								    (FONTSET 'JPRINT)
								    (SETQ !VALUE *)
								    (LIST (CAR !VALUE)
									  (PostIP (CADR !VALUE]
							 (T *])
(READVISE MAKEINTERPRESS)
(PUTPROPS JLISTFILES COPYRIGHT ("Fuji Xerox Co. Ltd. - All rights reverved." 1984))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (555 3076 (ContainJCharp 565 . 1004) (EncodeCES 1006 . 2141) (PostIP 2143 . 3074)))))
STOP