tm-mule.el

   1 ;;;
   2 ;;; $Id: tm-mule.el,v 6.5 1995/09/12 13:24:04 morioka Exp $
   3 ;;;
   4
   5 (require 'emu)
   6 (require 'tl-list)
   7
   8
   9 ;;; @ variables
  10 ;;;
  11
  12 (defvar mime/default-coding-system *ctext*)
  13
  14 (defvar mime/lc-charset-and-encoding-alist
  15   (list
  16    (cons lc-ascii nil)
  17    (cons lc-jp   '("ISO-2022-JP" . "B"))
  18    (cons lc-cn   '("ISO-2022-CN" . "B"))
  19    (cons lc-kr   '("EUC-KR"      . "B"))
  20    (cons lc-ltn1 '("ISO-8859-1"  . "Q"))
  21    (cons lc-ltn2 '("ISO-8859-2"  . "Q"))
  22    (cons lc-ltn3 '("ISO-8859-3"  . "Q"))
  23    (cons lc-ltn4 '("ISO-8859-4"  . "Q"))
  24    (cons lc-crl  '("ISO-8859-5"  . "B"))
  25 ;;;(cons lc-arb  '("ISO-8859-6"  . "B"))
  26    (cons lc-grk  '("ISO-8859-7"  . "B"))
  27    (cons lc-hbw  '("ISO-8859-8"  . "B"))
  28    (cons lc-ltn5 '("ISO-8859-9"  . "Q"))
  29    ))
  30
  31 (defvar mime/latin-lc-list
  32   (list lc-ascii lc-ltn1 lc-ltn2 lc-ltn3 lc-ltn4 lc-ltn5))
  33
  34 (defvar mime/charset-coding-system-alist
  35   '(("ISO-2022-JP"     . *iso-2022-ss2-7*)
  36     ("ISO-2022-JP-2"   . *iso-2022-ss2-7*)
  37     ("X-ISO-2022-JP-2" . *iso-2022-ss2-7*)
  38     ("ISO-2022-CN"     . *iso-2022-ss2-7*)
  39     ("ISO-2022-KR"     . *iso-2022-kr*)
  40     ("EUC-KR"          . *euc-kr*)
  41     ("ISO-8859-1"      . *ctext*)
  42     ("ISO-8859-2"      . *iso-8859-2*)
  43     ("ISO-8859-3"      . *iso-8859-3*)
  44     ("ISO-8859-4"      . *iso-8859-4*)
  45     ("ISO-8859-5"      . *iso-8859-5*)
  46     ("ISO-8859-7"      . *iso-8859-7*)
  47     ("ISO-8859-8"      . *iso-8859-8*)
  48     ("ISO-8859-9"      . *iso-8859-9*)
  49     ("ISO-2022-INT-1"  . *iso-2022-int-1*)
  50     ))
  51
  52 (defvar mime/charset-lc-alist
  53   (list
  54    (cons "ISO-8859-1" lc-ltn1) ; Latin-1
  55    (cons "ISO-8859-2" lc-ltn2) ; Latin-2
  56    (cons "ISO-8859-3" lc-ltn3) ; Latin-3
  57    (cons "ISO-8859-4" lc-ltn4) ; Latin-4
  58    (cons "ISO-8859-5" lc-crl ) ; Cyrillic
  59 ;;;(cons "ISO-8859-6" lc-arb ) ; Arabic
  60    (cons "ISO-8859-7" lc-grk ) ; Greek
  61    (cons "ISO-8859-8" lc-hbw ) ; Hebrew
  62    (cons "ISO-8859-9" lc-ltn5) ; Latin-5
  63    ))
  64
  65
  66 ;;; @ define charset and encoding
  67 ;;;
  68
  69 (defun mime/set-charset-and-encoding (lc cs charset encoding)
  70   (setq mime/lc-charset-and-encoding-alist
  71         (put-alist lc (cons charset encoding)
  72                    mime/lc-charset-and-encoding-alist))
  73   (if cs
  74       (setq mime/charset-coding-system-alist
  75             (put-alist charset cs mime/charset-coding-system-alist))
  76     (setq mime/charset-lc-alist
  77           (put-alist charset lc mime/charset-lc-alist))
  78     ))
  79 ;;; example
  80 ;;;
  81 ;;; (mime/set-charset-and-encoding lc-kr *euc-kr* "EUC-KR" "B")
  82 ;;; (mime/set-charset-and-encoding lc-koi8 nil "KOI8" "B")
  83
  84
  85 (defun mime/remove-leading-character (str)
  86   (let ((dest "") (i 0) (len (length str)) chr)
  87     (while (< i len)
  88       (setq chr (elt str i))
  89       (if (< chr 128)
  90           (progn
  91             (setq dest (concat dest (char-to-string chr)))
  92             (setq i (+ i 1))
  93             )
  94         (progn
  95           (setq dest (concat dest (char-to-string (elt str (+ i 1)))))
  96           (setq i (+ i 2))
  97           ))
  98       )
  99     dest))
 100
 101 (defun mime/insert-leading-character (str lc)
 102   (let ((lc-str (char-to-string lc))
 103         (dest "")
 104         (i 0) (len (length str))
 105         chr chr-str)
 106     (while (< i len)
 107       (setq chr (elt str i))
 108       (setq chr-str (char-to-string chr))
 109       (setq dest (concat dest
 110                          (if (< chr 128)
 111                              chr-str
 112                            (concat lc-str chr-str)
 113                            )))
 114       (setq i (+ i 1))
 115       )
 116     dest))
 117
 118 (defun mime/convert-string-to-emacs (charset str)
 119   (let ((cs (cdr (assoc charset mime/charset-coding-system-alist))))
 120     (cond (cs
 121            (code-convert-string str cs *internal*)
 122            )
 123           (t
 124            (let ((lc (cdr (assoc charset mime/charset-lc-alist))))
 125              (if lc
 126                  (mime/insert-leading-character str lc)
 127                )
 128              )))))
 129
 130 (defun mime/convert-string-from-emacs (str charset)
 131   (let ((cs (cdr (assoc charset mime/charset-coding-system-alist))))
 132     (cond (cs
 133            (code-convert-string str *internal* cs)
 134            )
 135           (t
 136            (if (assoc charset mime/charset-lc-alist)
 137                (mime/remove-leading-character str)
 138              str)))))
 139
 140
 141 (defun mime/code-convert-region-to-emacs (beg end charset &optional encoding)
 142   (if (stringp charset)
 143       (progn
 144         (setq charset (upcase charset))
 145         (let ((ct (cdr (assoc charset mime/charset-coding-system-alist))))
 146           (if ct
 147               (code-convert beg end ct *internal*)
 148             )))
 149     (if mime/default-coding-system
 150         (code-convert beg end mime/default-coding-system *internal*)
 151       )))
 152
 153
 154 ;;; @ end
 155 ;;;
 156
 157 (provide 'tm-mule)
 158
 159 (run-hooks 'tm-mule-load-hook)