[Mew-dist 890] chatch up to XEmacs 20.1 b15

[Kazu Yamamoto 山本和彦]

ボストンから帰ったら、XEmacs が b15 になっていて、すっかり浦島太郎な気分
の山本です。

とりあえず、XEmacs b15 では以下のコードで動くと思います。ただし、
GNU/Mule で動かないかもしれません。

基本的に beta をうたっている Emacs の仕様が変更になった場合は、それに
追い付くつもりです。過去との互換性は残しません。XEmacs/Mule と 
GNU/Mule は最終的に API が同じになるそうなので、しばらくすれば混乱もな
くなるでしょう。beta ですから、使う方もそれなりに覚悟しましょう。

--かず＠日本はあったかい

-------------- next part --------------
;;;			     mew-mule3.el
;;;
;;;		Copyright (C) 1997  Kazuhiko Yamamoto
;;;
;;;		   This emacs lisp library conforms
;;;		GNU GENERAL PUBLIC LICENSE Version 2.
;;;
;;; Author:  Kazuhiko Yamamoto <kazu at example.com>
;;; Created: March 20, 1997
;;; Revised: April 16, 1997
;;;

(defconst mew-mule3-version "mew-mule3.el version 0.05")

;;
;; Charset
;;

(defvar mew-cs-noconv       'no-conversion)
(defvar mew-cs-autoconv	    'automatic-conversion)
(defvar mew-cs-7bit         'iso-2022-ss2-7)
(defvar mew-cs-7bit-crlf    'iso-2022-ss2-7-dos)

(defvar mew-cs-mime-trans   'iso-2022-ss2-7)
(defvar mew-cs-rfc822-trans 'iso-2022-ss2-7)
(defvar mew-cs-draft        'iso-2022-jp)
(defvar mew-cs-scan         'iso-2022-jp) ;; iso-2022-int-1?
(defvar mew-cs-spool        'no-conversion)
(defvar mew-cs-infile       'automatic-conversion)
(defvar mew-cs-outfile      'iso-2022-jp)
(defvar mew-cs-virtual      'iso-2022-jp-unix) ;; ^M as it is

(defvar mew-mule-character-set
  '(('ascii	        nil            "us-ascii")
    (latin-1            iso-8859-1     "iso-8859-1")
    (latin-2            iso-8859-2     "iso-8859-2")
    (latin-3            iso-8859-3     "iso-8859-3")
    (latin-4            iso-8859-4     "iso-8859-4")
    (cyrillic           iso-8859-5     "iso-8859-5")
    (arabic             iso-8859-6     "iso-8859-6")
    (greek              iso-8859-7     "iso-8859-7")
    (hebrew             iso-8859-8     "iso-8859-8")
    (latin-5            iso-8859-9     "iso-8859-9")
    (japanese-jisx0208  iso-2022-jp    "iso-2022-jp")
    (t	                iso-2022-int-1 "iso-2022-int-1"))
  )

;;
;; Charset2
;;

(defvar mew-mule-mime-charset 
  (mapcar (function (lambda (x) (nth 2 x))) mew-mule-character-set))

(defmacro mew-mule-lc-attr (lc alist)
  (` (mew-assoc (, lc) (, alist) 0 nil)))

(defmacro mew-mule-lc-attr-by-charset (lc alist)
  (` (mew-assoc (, lc) (, alist) 2 t)))

(defmacro mew-mule-lc-content (attr)
  (` (car (cdr (cdr (, attr))))))

(defmacro mew-mule-lc-symbol (attr)
  (` (car (cdr (, attr)))))

(defun mew-charset-to-symbol (charset)
  (if charset
      (mew-mule-lc-symbol 
       (mew-mule-lc-attr-by-charset charset mew-mule-character-set))
    nil)
  )

(defmacro mew-mule-content-attr (content alist)
  (` (mew-assoc2 (, content) (, alist) 2 t)))

(defmacro mew-mule-content-coding (attr)
  (` (car (cdr (, attr)))))

;;
;; Charset guess
;;

(defun mew-charset-guess-region (beg end)
  (interactive "r")
  "Guess minimum character set name."
  (let* ((lc (delete 'ascii (find-charset-region beg end))))
    (cond
     ((null lc) "us-ascii")
     ((equal (length lc) 1)
      (mew-mule-lc-content 
       (mew-mule-lc-attr (car lc) mew-mule-character-set)))
     (t 
      (if (and (member 'latin-jisx0201 lc) (member 'japanese-jisx0208 lc))
	  "iso-2022-jp"
	"iso-2022-jp-2")
      )
     )
    ))

(defun mew-charset-guess-string (str)
  (interactive)
  "Guess minimum character set name."
  (let* ((lc (delete 'ascii (find-charset-string str))))
    (cond
     ((null lc) "us-ascii") ;; in case of ""
     ((equal (length lc) 1)
      (mew-mule-lc-content 
       (mew-mule-lc-attr (car lc) mew-mule-character-set)))
     (t
      (if (and (member 'latin-jisx0201 lc) (member 'japanese-jisx0208 lc))
	  "iso-2022-jp"
	"iso-2022-jp-2")
      )
     )
    ))

;;
;; Charset conversion
;;

;; to internal
(defun mew-cs-decode-region (beg end cs &optional charsetp)
  (if (null cs)
      ()
    (let (from attr)
      (if (null charsetp)
	  (setq from cs)
	(setq cs (downcase cs))
	(setq attr (mew-mule-content-attr cs mew-mule-character-set))
	(setq from (mew-mule-content-coding attr)))
      (if from (decode-coding-region beg end from))
      )
    ))

;; to extenal
(defun mew-cs-encode-region (beg end cs &optional charsetp)
  (if (null cs)
      ()
    (let (to attr)
      (if (null charsetp)
	  (setq to cs)
	(setq cs (downcase cs))
	(setq attr (mew-mule-content-attr cs mew-mule-character-set))
	(setq to (mew-mule-content-coding attr cs)))
      (if to (encode-coding-region beg end to))
      )
    ))

;; to internal
(defun mew-cs-decode-string (str cs &optional charsetp)
  (if (null cs)
      ()
    (let (from attr)
      (if (null charsetp)
	  (setq from cs)
	(setq cs (downcase cs))
	(setq attr (mew-mule-content-attr cs mew-mule-character-set))
	(setq from (mew-mule-content-coding attr)))
      (if from (decode-coding-string str from) str)
      )
    ))

;; to external
(defun mew-cs-encode-string (str cs &optional charsetp)
  (if (null cs)
      ()
    (let (to attr)
      (if (null charsetp)
	  (setq to cs)
	(setq cs (downcase cs))
	(setq attr (mew-mule-content-attr cs mew-mule-character-set))
	(setq to (mew-mule-content-coding attr)))
      (if to (encode-coding-string str to) str)
      )
    ))

;;
;; Process environment
;;

(defun mew-set-process-cs (process read write)
  (set-process-coding-system process read write)
  )

(defmacro mew-plet (&rest body)
  `(let ((call-process-hook nil)
	 (coding-system-for-read  nil) ;; xxx why not no-conversion?
	 (coding-system-for-write nil))
     , at example.com)
  )

(defmacro mew-piolet (read write &rest body)
  `(let ((call-process-hook nil)
	 (coding-system-for-read  ,read)
	 (coding-system-for-write ,write))
     , at example.com)
  )

(defmacro mew-flet (&rest body)
  `(let ((coding-system-for-read  'no-conversion)
	 (coding-system-for-write 'no-conversion))
     , at example.com)
  )

(defmacro mew-frwlet (read write &rest body)
  `(let ((coding-system-for-read  ,read)
	 (coding-system-for-write ,write))
     , at example.com)
  )

(provide 'mew-mule3)