tm-mule.el

   1 ;;;
   2 ;;; tm-mule.el --- tm definitions depended on Mule
   3 ;;;
   4 ;;; Copyright (C) 1995 Free Software Foundation, Inc.
   5 ;;; Copyright (C) 1994,1995 MORIOKA Tomohiko
   6 ;;;
   7 ;;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
   8 ;;; Version:
   9 ;;;     $Id: tm-mule.el,v 7.1 1995/10/03 04:49:53 morioka Exp $
  10 ;;; Keywords: mail, news, MIME, multimedia, multilingual, encoded-word
  11 ;;;
  12 ;;; This file is part of tm (Tools for MIME).
  13 ;;;
  14
  15 (require 'emu)
  16 (require 'tl-list)
  17
  18
  19 ;;; @ coding-system
  20 ;;;
  21
  22 (defvar mime/default-coding-system *ctext*)
  23
  24 (defvar mime/charset-coding-system-alist
  25   '(("ISO-2022-JP"     . *iso-2022-ss2-7*)
  26     ("ISO-2022-JP-2"   . *iso-2022-ss2-7*)
  27     ("X-ISO-2022-JP-2" . *iso-2022-ss2-7*)
  28     ("ISO-2022-CN"     . *iso-2022-ss2-7*)
  29     ("ISO-2022-KR"     . *iso-2022-kr*)
  30     ("EUC-KR"          . *euc-kr*)
  31     ("ISO-8859-1"      . *ctext*)
  32     ("ISO-8859-2"      . *iso-8859-2*)
  33     ("ISO-8859-3"      . *iso-8859-3*)
  34     ("ISO-8859-4"      . *iso-8859-4*)
  35     ("ISO-8859-5"      . *iso-8859-5*)
  36     ("ISO-8859-7"      . *iso-8859-7*)
  37     ("ISO-8859-8"      . *iso-8859-8*)
  38     ("ISO-8859-9"      . *iso-8859-9*)
  39     ("ISO-2022-INT-1"  . *iso-2022-int-1*)
  40     ))
  41
  42
  43 ;;; @ charset and encoding
  44 ;;;
  45
  46 (defvar mime/lc-charset-rule-list
  47   (list
  48    (list (list lc-ascii)         "US-ASCII"    nil)
  49    (list (list lc-ascii lc-ltn1) "ISO-8859-1"  "Q")
  50    (list (list lc-ascii lc-ltn2) "ISO-8859-2"  "Q")
  51    (list (list lc-ascii lc-ltn3) "ISO-8859-3"  "Q")
  52    (list (list lc-ascii lc-ltn4) "ISO-8859-4"  "Q")
  53 ;;;(list (list lc-ascii lc-crl)  "ISO-8859-5"  "Q")
  54    (list (list lc-ascii lc-crl)  "KOI8-R"      "Q")
  55    (list (list lc-ascii lc-grk)  "ISO-8859-7"  "Q")
  56    (list (list lc-ascii lc-hbw)  "ISO-8859-8"  "Q")
  57    (list (list lc-ascii lc-ltn5) "ISO-8859-9"  "Q")
  58    (list (list lc-ascii lc-jp)   "ISO-2022-JP" "B")
  59    (list (list lc-ascii lc-kr)   "EUC-KR"      "B")
  60    (list (list lc-ascii
  61                lc-jp lc-cn
  62                lc-kr lc-jp2
  63                lc-ltn1 lc-grk) "ISO-2022-JP-2" "B")
  64    (list (list lc-ascii
  65                lc-jp lc-cn
  66                lc-kr lc-jp2
  67                lc-cns1 lc-cns2
  68                lc-ltn1 lc-grk) "ISO-2022-INT-1" "B")
  69    ))
  70
  71 (defvar mime/unknown-charset-rule '("ISO-2022-INT-1" "B"))
  72
  73
  74 ;;; @ (obsoleted)
  75 ;;;
  76
  77 (defvar mime/lc-charset-and-encoding-alist
  78   (list
  79    (cons lc-ascii nil)
  80    (cons lc-jp   '("ISO-2022-JP" . "B"))
  81    (cons lc-cn   '("ISO-2022-CN" . "B"))
  82    (cons lc-kr   '("EUC-KR"      . "B"))
  83    (cons lc-ltn1 '("ISO-8859-1"  . "Q"))
  84    (cons lc-ltn2 '("ISO-8859-2"  . "Q"))
  85    (cons lc-ltn3 '("ISO-8859-3"  . "Q"))
  86    (cons lc-ltn4 '("ISO-8859-4"  . "Q"))
  87    (cons lc-crl  '("ISO-8859-5"  . "B"))
  88 ;;;(cons lc-arb  '("ISO-8859-6"  . "B"))
  89    (cons lc-grk  '("ISO-8859-7"  . "B"))
  90    (cons lc-hbw  '("ISO-8859-8"  . "B"))
  91    (cons lc-ltn5 '("ISO-8859-9"  . "Q"))
  92    ))
  93
  94 (defvar mime/latin-lc-list
  95   (list lc-ascii lc-ltn1 lc-ltn2 lc-ltn3 lc-ltn4 lc-ltn5))
  96
  97 (defvar mime/charset-lc-alist
  98   (list
  99    (cons "ISO-8859-1" lc-ltn1) ; Latin-1
 100    (cons "ISO-8859-2" lc-ltn2) ; Latin-2
 101    (cons "ISO-8859-3" lc-ltn3) ; Latin-3
 102    (cons "ISO-8859-4" lc-ltn4) ; Latin-4
 103    (cons "ISO-8859-5" lc-crl ) ; Cyrillic
 104 ;;;(cons "ISO-8859-6" lc-arb ) ; Arabic
 105    (cons "ISO-8859-7" lc-grk ) ; Greek
 106    (cons "ISO-8859-8" lc-hbw ) ; Hebrew
 107    (cons "ISO-8859-9" lc-ltn5) ; Latin-5
 108    ))
 109
 110 (defun mime/set-charset-and-encoding (lc cs charset encoding)
 111   (setq mime/lc-charset-and-encoding-alist
 112         (put-alist lc (cons charset encoding)
 113                    mime/lc-charset-and-encoding-alist))
 114   (if cs
 115       (setq mime/charset-coding-system-alist
 116             (put-alist charset cs mime/charset-coding-system-alist))
 117     (setq mime/charset-lc-alist
 118           (put-alist charset lc mime/charset-lc-alist))
 119     ))
 120 ;;; example
 121 ;;;
 122 ;;; (mime/set-charset-and-encoding lc-kr *euc-kr* "EUC-KR" "B")
 123 ;;; (mime/set-charset-and-encoding lc-koi8 nil "KOI8" "B")
 124
 125
 126 (defun mime/remove-leading-character (str)
 127   (let ((dest "") (i 0) (len (length str)) chr)
 128     (while (< i len)
 129       (setq chr (elt str i))
 130       (if (< chr 128)
 131           (progn
 132             (setq dest (concat dest (char-to-string chr)))
 133             (setq i (+ i 1))
 134             )
 135         (progn
 136           (setq dest (concat dest (char-to-string (elt str (+ i 1)))))
 137           (setq i (+ i 2))
 138           ))
 139       )
 140     dest))
 141
 142 (defun mime/insert-leading-character (str lc)
 143   (let ((lc-str (char-to-string lc))
 144         (dest "")
 145         (i 0) (len (length str))
 146         chr chr-str)
 147     (while (< i len)
 148       (setq chr (elt str i))
 149       (setq chr-str (char-to-string chr))
 150       (setq dest (concat dest
 151                          (if (< chr 128)
 152                              chr-str
 153                            (concat lc-str chr-str)
 154                            )))
 155       (setq i (+ i 1))
 156       )
 157     dest))
 158
 159
 160 ;;; @ functions
 161 ;;;
 162
 163 (defun mime/convert-string-to-emacs (charset str)
 164   (let ((cs (cdr (assoc charset mime/charset-coding-system-alist))))
 165     (cond (cs
 166            (code-convert-string str cs *internal*)
 167            )
 168           (t
 169            (let ((lc (cdr (assoc charset mime/charset-lc-alist))))
 170              (if lc
 171                  (mime/insert-leading-character str lc)
 172                )
 173              )))))
 174
 175 (defun mime/convert-string-from-emacs (str charset)
 176   (let ((cs (cdr (assoc charset mime/charset-coding-system-alist))))
 177     (cond (cs
 178            (code-convert-string str *internal* cs)
 179            )
 180           (t
 181            (if (assoc charset mime/charset-lc-alist)
 182                (mime/remove-leading-character str)
 183              str)))))
 184
 185
 186 (defun mime/code-convert-region-to-emacs (beg end charset &optional encoding)
 187   (if (stringp charset)
 188       (progn
 189         (setq charset (upcase charset))
 190         (let ((ct (cdr (assoc charset mime/charset-coding-system-alist))))
 191           (if ct
 192               (code-convert beg end ct *internal*)
 193             )))
 194     (if mime/default-coding-system
 195         (code-convert beg end mime/default-coding-system *internal*)
 196       )))
 197
 198
 199 ;;; @ end
 200 ;;;
 201
 202 (provide 'tm-mule)
 203
 204 (run-hooks 'tm-mule-load-hook)