tm-mule.el

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