tm-mule.el

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