;;;
;;; tm-mule.el --- tm definitions depended on Mule
;;;
;;; Copyright (C) 1995 Free Software Foundation, Inc.
;;; Copyright (C) 1994,1995 MORIOKA Tomohiko
;;;
;;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
;;; Version:
;;;	$Id: tm-mule.el,v 7.1 1995/10/03 04:49:53 morioka Exp $
;;; Keywords: mail, news, MIME, multimedia, multilingual, encoded-word
;;;
;;; This file is part of tm (Tools for MIME).
;;;

(require 'emu)
(require 'tl-list)


;;; @ coding-system
;;;

(defvar mime/default-coding-system *ctext*)

(defvar mime/charset-coding-system-alist
  '(("ISO-2022-JP"     . *iso-2022-ss2-7*)
    ("ISO-2022-JP-2"   . *iso-2022-ss2-7*)
    ("X-ISO-2022-JP-2" . *iso-2022-ss2-7*)
    ("ISO-2022-CN"     . *iso-2022-ss2-7*)
    ("ISO-2022-KR"     . *iso-2022-kr*)
    ("EUC-KR"          . *euc-kr*)
    ("ISO-8859-1"      . *ctext*)
    ("ISO-8859-2"      . *iso-8859-2*)
    ("ISO-8859-3"      . *iso-8859-3*)
    ("ISO-8859-4"      . *iso-8859-4*)
    ("ISO-8859-5"      . *iso-8859-5*)
    ("ISO-8859-7"      . *iso-8859-7*)
    ("ISO-8859-8"      . *iso-8859-8*)
    ("ISO-8859-9"      . *iso-8859-9*)
    ("ISO-2022-INT-1"  . *iso-2022-int-1*)
    ))


;;; @ charset and encoding
;;;

(defvar mime/lc-charset-rule-list
  (list
   (list (list lc-ascii)         "US-ASCII"    nil)
   (list (list lc-ascii lc-ltn1) "ISO-8859-1"  "Q")
   (list (list lc-ascii lc-ltn2) "ISO-8859-2"  "Q")
   (list (list lc-ascii lc-ltn3) "ISO-8859-3"  "Q")
   (list (list lc-ascii lc-ltn4) "ISO-8859-4"  "Q")
;;;(list (list lc-ascii lc-crl)  "ISO-8859-5"  "Q")
   (list (list lc-ascii lc-crl)  "KOI8-R"      "Q")
   (list (list lc-ascii lc-grk)  "ISO-8859-7"  "Q")
   (list (list lc-ascii lc-hbw)  "ISO-8859-8"  "Q")
   (list (list lc-ascii lc-ltn5) "ISO-8859-9"  "Q")
   (list (list lc-ascii lc-jp)   "ISO-2022-JP" "B")
   (list (list lc-ascii lc-kr)   "EUC-KR"      "B")
   (list (list lc-ascii
	       lc-jp lc-cn
	       lc-kr lc-jp2
	       lc-ltn1 lc-grk) "ISO-2022-JP-2" "B")
   (list (list lc-ascii
	       lc-jp lc-cn
	       lc-kr lc-jp2
	       lc-cns1 lc-cns2
	       lc-ltn1 lc-grk) "ISO-2022-INT-1" "B")
   ))

(defvar mime/unknown-charset-rule '("ISO-2022-INT-1" "B"))


;;; @ (obsoleted)
;;;

(defvar mime/lc-charset-and-encoding-alist
  (list
   (cons lc-ascii nil)
   (cons lc-jp   '("ISO-2022-JP" . "B"))
   (cons lc-cn   '("ISO-2022-CN" . "B"))
   (cons lc-kr   '("EUC-KR"      . "B"))
   (cons lc-ltn1 '("ISO-8859-1"  . "Q"))
   (cons lc-ltn2 '("ISO-8859-2"  . "Q"))
   (cons lc-ltn3 '("ISO-8859-3"  . "Q"))
   (cons lc-ltn4 '("ISO-8859-4"  . "Q"))
   (cons lc-crl  '("ISO-8859-5"  . "B"))
;;;(cons lc-arb  '("ISO-8859-6"  . "B"))
   (cons lc-grk  '("ISO-8859-7"  . "B"))
   (cons lc-hbw  '("ISO-8859-8"  . "B"))
   (cons lc-ltn5 '("ISO-8859-9"  . "Q"))
   ))

(defvar mime/latin-lc-list
  (list lc-ascii lc-ltn1 lc-ltn2 lc-ltn3 lc-ltn4 lc-ltn5))

(defvar mime/charset-lc-alist
  (list
   (cons "ISO-8859-1" lc-ltn1) ; Latin-1
   (cons "ISO-8859-2" lc-ltn2) ; Latin-2
   (cons "ISO-8859-3" lc-ltn3) ; Latin-3
   (cons "ISO-8859-4" lc-ltn4) ; Latin-4
   (cons "ISO-8859-5" lc-crl ) ; Cyrillic
;;;(cons "ISO-8859-6" lc-arb ) ; Arabic
   (cons "ISO-8859-7" lc-grk ) ; Greek
   (cons "ISO-8859-8" lc-hbw ) ; Hebrew
   (cons "ISO-8859-9" lc-ltn5) ; Latin-5
   ))

(defun mime/set-charset-and-encoding (lc cs charset encoding)
  (setq mime/lc-charset-and-encoding-alist
	(put-alist lc (cons charset encoding)
		   mime/lc-charset-and-encoding-alist))
  (if cs
      (setq mime/charset-coding-system-alist
	    (put-alist charset cs mime/charset-coding-system-alist))
    (setq mime/charset-lc-alist
	  (put-alist charset lc mime/charset-lc-alist))
    ))
;;; example
;;;
;;; (mime/set-charset-and-encoding lc-kr *euc-kr* "EUC-KR" "B")
;;; (mime/set-charset-and-encoding lc-koi8 nil "KOI8" "B")


(defun mime/remove-leading-character (str)
  (let ((dest "") (i 0) (len (length str)) chr)
    (while (< i len)
      (setq chr (elt str i))
      (if (< chr 128)
	  (progn
	    (setq dest (concat dest (char-to-string chr)))
	    (setq i (+ i 1))
	    )
	(progn
	  (setq dest (concat dest (char-to-string (elt str (+ i 1)))))
	  (setq i (+ i 2))
	  ))
      )
    dest))

(defun mime/insert-leading-character (str lc)
  (let ((lc-str (char-to-string lc))
	(dest "")
	(i 0) (len (length str))
	chr chr-str)
    (while (< i len)
      (setq chr (elt str i))
      (setq chr-str (char-to-string chr))
      (setq dest (concat dest
			 (if (< chr 128)
			     chr-str
			   (concat lc-str chr-str)
			   )))
      (setq i (+ i 1))
      )
    dest))


;;; @ functions
;;;

(defun mime/convert-string-to-emacs (charset str)
  (let ((cs (cdr (assoc charset mime/charset-coding-system-alist))))
    (cond (cs
	   (code-convert-string str cs *internal*)
	   )
	  (t
	   (let ((lc (cdr (assoc charset mime/charset-lc-alist))))
	     (if lc
		 (mime/insert-leading-character str lc)
	       )
	     )))))

(defun mime/convert-string-from-emacs (str charset)
  (let ((cs (cdr (assoc charset mime/charset-coding-system-alist))))
    (cond (cs
	   (code-convert-string str *internal* cs)
	   )
	  (t
	   (if (assoc charset mime/charset-lc-alist)
	       (mime/remove-leading-character str)
	     str)))))


(defun mime/code-convert-region-to-emacs (beg end charset &optional encoding)
  (if (stringp charset)
      (progn
	(setq charset (upcase charset))
	(let ((ct (cdr (assoc charset mime/charset-coding-system-alist))))
	  (if ct
	      (code-convert beg end ct *internal*)
	    )))
    (if mime/default-coding-system
	(code-convert beg end mime/default-coding-system *internal*)
      )))


;;; @ end
;;;

(provide 'tm-mule)

(run-hooks 'tm-mule-load-hook)