🚀 go-pugleaf

In article <tl7af0lr50w.fsf@etl.go.jp>
	Kenichi Handa <handa@etl.go.jp> writes:

>Mule を起動して以下のように文字セットを定義した上で、
>
>(set-fontset-font 
>  "16" lc-jp3 
>  "-misc-fixed-medium-r-normal--16-150-75-75-c-160-jisx0213.1999-1)
>
>を実行すればよいはずです。

これで表示されるようになりました。ありがとうございます。ついでにシフト
JISも使えるようにしようと思い、下のようなCCLを書いています(勝手がわか
らないのでとても冗長ですが)。どうにかロード・セーブできるようにはなっ
たのですが、まだ原因不明のバグがあるようです。どなたか興味のある方はデ
バグしてください。_o_

;; newjis.el - support for new JIS (JIS X 0213-1999 Plane 1, 2)
;; Copyright (C) 1998 ITO Takayuki.

;; CAUTION:
;;
;; The standard is currently being reviewed. Not yet fixed.
;; Do not use the standard and this code for practical purposes.
;;
;; The standard name JISX0213, published year 1999,
;; and final characters ?O and ?P are nothing but prediction.
;; EUC and Shift-JIS encodings are also draft proposal.
;; When the formal standard is published they may change.
;;
;; CCL routines for Shift-JIS assume lc-jp3 == 251 and lc-jp4 == 252.
;; If you have already defined other 2-byte 2-column private character sets,
;; you need to change these hard-coded values.

;; BUGS:
;;
;; This elisp code is of alpha quality. Not yet tested thoroughly.
;;
;; EUC file may be recognized as *euc-japan* even though explicitly
;; specified as *euc-japan-new* in reading.
;;
;; SJIS(CR/LF) file may be recognized as *sjis-new*unix even though
;; explicitly specified as *sjis-new*dos in reading.
;;
;; A few ASCII characters may drop in writing SJIS file.

;;; 98.12.19 created for Mule 2.3@19.28 by ITO Takayuki <yuki@dayo.ne.jp>

;; define character sets

(defvar lc-jp3
	(new-private-character-set 2 2 2 0 ?O 0 "Japanese Level 3" "JISX0213.1999-1")
	"Leading character for JIS X 0213 Plane 1, Japanese characters Level 3.")
(defvar lc-jp4
	(new-private-character-set 2 2 2 0 ?P 0 "Japanese Level 4" "JISX0213.1999-2")
	"Leading character for JIS X 0213 Plane 2, Japanese characters Level 4.")

;; bind character sets to fonts

(if (eq window-system 'x)
	(progn
		(set-fontset-font 
			"16" lc-jp3
			"-misc-fixed-medium-r-normal--16-150-75-75-c-160-jisx0213.1999-1")
		(set-fontset-font 
			"16" lc-jp4
			"-misc-fixed-medium-r-normal--16-150-75-75-c-160-jisx0213.1999-2")))

;; define coding system: EUC

(make-coding-system
	'*euc-japan-new* 2 ?e
	"Coding-system of Alternative Japanese EUC (Extended Unix Code)." t
	(list lc-ascii lc-jp3 lc-jp4 nil
		'short 'ascii-eol 'ascii-cntl))

;; define coding system: SJIS

(define-ccl-program ccl-read-sjis-new
	'(3
		((read r0)
		 (loop
			;; 0x00 - 0x7F (ASCII)
			(if (r0 < 128)
				(write-read-repeat r0)
			;; 0x80 (invalid)
			(if (r0 == 128)
				((read r0) (repeat))
			;; 0x81 - 0x9F (JIS X 0213 Plane 1 Row 1 - 62)
			(if (r0 < 160)
				((read r1)
				 (if (r1 <   64) ((read r0) (repeat)))
				 (if (r1 == 127) ((read r0) (repeat)))
				 (if (r1 >  252) ((read r0) (repeat)))
				 (r0 -= 129)
				 (r0 *= 2)
				 (if (r1 > 127) (r1 -= 1))
				 (r1 -= 64)
				 (if (r1 >= 94) ((r1 -= 94) (r0 += 1)))
				 (r0 += 161)
				 (r1 += 161)
				 (write 157)	;LCPRV2
				 (write 251)	;lc-jp3
				 (write r0)
				 (write r1)
				 (read r0)
				 (repeat))
			;; 0xA0 - 0xDF (JIS X 0201 Katakana)
			(if (r0 < 224)
				((write 137)	;lc-kana
				 (write-read-repeat r0))
			;; 0xE0 - 0xEF (JIS X 0213 Plane 1 Row 63 - 94)
			(if (r0 < 240)
				((read r1)
				 (r0 -= 64)
				 ;; same as above
				 (if (r1 <   64) ((read r0) (repeat)))
				 (if (r1 == 127) ((read r0) (repeat)))
				 (if (r1 >  252) ((read r0) (repeat)))
				 (r0 -= 129)
				 (r0 *= 2)
				 (if (r1 > 127) (r1 -= 1))
				 (r1 -= 64)
				 (if (r1 >= 94) ((r1 -= 94) (r0 += 1)))
				 (r0 += 161)
				 (r1 += 161)
				 (write 157)	;LCPRV2
				 (write 251)	;lc-jp3
				 (write r0)
				 (write r1)
				 (read r0)
				 (repeat))
			;; 0xF0 - 0xFE (JIS X 0213 Plane 2 Row 65 - 94)
			(if (r0 < 255)
				((read r1)
				 ;; almost same as above
				 (r0 -= 240)	;from 0xF040
				 (r0 *= 2)
				 (r0 += 64)	;from Row 65
				 (if (r1 <   64) ((read r0) (repeat)))
				 (if (r1 == 127) ((read r0) (repeat)))
				 (if (r1 >  252) ((read r0) (repeat)))
				 (if (r1 > 127) (r1 -= 1))
				 (r1 -= 64)
				 (if (r1 >= 94) ((r1 -= 94) (r0 += 1)))
				 (r0 += 161)
				 (r1 += 161)
				 (write 157)	;LCPRV2
				 (write 252)	;lc-jp4
				 (write r0)
				 (write r1)
				 (read r0)
				 (repeat))
			;; 0xFF (invalid)
			((read r0) (repeat)))))))))))
	"CCL program to read alternative Shift-JIS.")

(define-ccl-program ccl-write-sjis-new
	'(1
		((read r0)
		 (loop
			;; ASCII
			(if (r0 < 128)
				(write-read-repeat r0)
			;; JIS X 0201 katakana
			(if (r0 == 137)		;lc-kana
				((read r0)
				 (write-read-repeat r0))
			;; JIS X 0208
			(if (r0 == 146)		;lc-jp
				((read r0)
				 (read r1)
				 (r0 -= 161)
				 (r1 -= 161)
				 (if (r0 & 1 == 1) (r1 += 94))
				 (r1 += 64)
				 (if (r1 >= 127) (r1 += 1))
				 (r0 /= 2)
				 (r0 += 129)
				 (if (r0 >= 160) (r0 += 64))
				 (write r0)
				 (write r1)
				 (read r0)
				 (repeat))
			;; JIS X 0208
			(if (r0 == 144)		;lc-jpold
				;; same as above
				((read r0)
				 (read r1)
				 (r0 -= 161)
				 (r1 -= 161)
				 (if (r0 & 1 == 1) (r1 += 94))
				 (r1 += 64)
				 (if (r1 >= 127) (r1 += 1))
				 (r0 /= 2)
				 (r0 += 129)
				 (if (r0 >= 160) (r0 += 64))
				 (write r0)
				 (write r1)
				 (read r0)
				 (repeat))
			(if (r0 == 157)		;LCPRV2
				((read r0)
				 ;; JIS X 0213 Plane 1
				 (if (r0 == 251)	;lc-jp3
					;; same as above
					((read r0)
					 (read r1)
					 (r0 -= 161)
					 (r1 -= 161)
					 (if (r0 & 1 == 1) (r1 += 94))
					 (r1 += 64)
					 (if (r1 >= 127) (r1 += 1))
					 (r0 /= 2)
					 (r0 += 129)
					 (if (r0 >= 160) (r0 += 64))
					 (write r0)
					 (write r1)
					 (read r0)
					 (repeat))
				 ;; JIS X 0213 Plane 2
				 (if (r0 == 252)	;lc-jp4
					;; almost same as above
					((read r0)
					 (read r1)
					 (r0 -= 161)
					 (r1 -= 161)
					 ;; Row 1-64 are reserved and
					 ;; cannot be encoded in SJIS
					 (if (r0 < 64) ((read r0) (repeat)))
					 (if (r0 & 1 == 1) (r1 += 94))
					 (r1 += 64)
					 (if (r1 >= 127) (r1 += 1))
					 (r0 -= 64)	;from Row 65
					 (r0 /= 2)
					 (r0 += 240)	;from 0xF040
					 (write r0)
					 (write r1)
					 (read r0)
					 (repeat)))))
			;; other (invalid)
			((read r0) (repeat))))))))))
	"CCL program to write alternative Shift-JIS.")
				   
(make-coding-system
	'*sjis-new* 4 ?s
	"Alternative Shift-JIS (based on JIS X 0213)." t
	(cons ccl-read-sjis-new ccl-write-sjis-new))

;(setq *coding-category-iso-8-2* '*euc-japan-new*)
;(setq *coding-category-sjis* '*sjis-new*)
;(set-coding-priority
;	'(*coding-category-iso-8-2*
;	  *coding-category-sjis*
;	  *coding-category-iso-8-1*
;	  *coding-category-big5*))


--
伊藤隆幸 (ITO Takayuki)