- Split core about MIME charset from emu to mcharset.
;;; Code:
-(setq emu-modules '(poe poem emu))
+(setq emu-modules '(poe poem mcharset emu))
(setq emu-modules
(nconc
(cons 'poe-xemacs
(if (featurep 'mule)
;; for XEmacs with MULE
- '(poem-20 poem-xm emu-20 emu-x20)
+ '(poem-20 poem-xm mcs-20 mcs-xm emu-20 emu-x20)
;; for XEmacs without MULE
- '(poem-ltn1 emu-latin1)
+ '(poem-ltn1 mcs-ltn1 emu-latin1)
))
)
(running-mule-merged-emacs
'poem-e20_3 ; for Emacs 20.3
'poem-e20_2 ; for Emacs 20.1 and 20.2
)
- '(poe-19 poem-20 poem-e20 emu-20 emu-e20))
+ '(poe-19 poem-20 poem-e20 mcs-20 mcs-e20 emu-20 emu-e20))
)
((boundp 'MULE)
;; for MULE 1.* and MULE 2.*
- (append '(poem-om emu-mule)
+ (append '(poem-om mcs-om emu-mule)
(if running-emacs-18
'(poe-18 env)
'(poe-19)))
)
((boundp 'NEMACS)
;; for NEmacs
- '(poe-18 poem-nemacs emu-nemacs)
+ '(poe-18 poem-nemacs mcs-nemacs emu-nemacs)
)
(t
;; for Emacs 19.34
- '(poe-19 poem-ltn1 emu-latin1)
+ '(poe-19 poem-ltn1 mcs-ltn1 emu-latin1)
))
emu-modules))
+++ /dev/null
-;;; emu-20.el --- emu API implementation for Emacs 20 and XEmacs/mule
-
-;; Copyright (C) 1997,1998 Free Software Foundation, Inc.
-
-;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; Keywords: emulation, compatibility, Mule
-
-;; This file is part of emu.
-
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation; either version 2, or (at
-;; your option) any later version.
-
-;; This program is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; This module requires Emacs 20.0.93, XEmacs 20.3-b5 (with mule)
-;; or later.
-
-;;; Code:
-
-(require 'poem)
-(require 'custom)
-(eval-when-compile (require 'wid-edit))
-
-
-;;; @ MIME charset
-;;;
-
-(defcustom mime-charset-coding-system-alist
- `,(let ((rest
- '((us-ascii . raw-text)
- (gb2312 . cn-gb-2312)
- (iso-2022-jp-2 . iso-2022-7bit-ss2)
- (x-ctext . ctext)
- (unknown . undecided)
- (x-unknown . undecided)
- ))
- dest)
- (while rest
- (let ((pair (car rest)))
- (or (find-coding-system (car pair))
- (setq dest (cons pair dest))
- ))
- (setq rest (cdr rest))
- )
- dest)
- "Alist MIME CHARSET vs CODING-SYSTEM.
-MIME CHARSET and CODING-SYSTEM must be symbol."
- :group 'i18n
- :type '(repeat (cons symbol coding-system)))
-
-(defsubst mime-charset-to-coding-system (charset &optional lbt)
- "Return coding-system corresponding with CHARSET.
-CHARSET is a symbol whose name is MIME charset.
-If optional argument LBT (`CRLF', `LF', `CR', `unix', `dos' or `mac')
-is specified, it is used as line break code type of coding-system."
- (if (stringp charset)
- (setq charset (intern (downcase charset)))
- )
- (let ((ret (assq charset mime-charset-coding-system-alist)))
- (if ret
- (setq charset (cdr ret))
- ))
- (if lbt
- (setq charset (intern (format "%s-%s" charset
- (cond ((eq lbt 'CRLF) 'dos)
- ((eq lbt 'LF) 'unix)
- ((eq lbt 'CR) 'mac)
- (t lbt)))))
- )
- (if (find-coding-system charset)
- charset
- ))
-
-(defsubst mime-charset-list ()
- "Return a list of all existing MIME-charset."
- (nconc (mapcar (function car) mime-charset-coding-system-alist)
- (coding-system-list)))
-
-
-(defvar widget-mime-charset-prompt-value-history nil
- "History of input to `widget-mime-charset-prompt-value'.")
-
-(define-widget 'mime-charset 'coding-system
- "A mime-charset."
- :format "%{%t%}: %v"
- :tag "MIME-charset"
- :prompt-history 'widget-mime-charset-prompt-value-history
- :prompt-value 'widget-mime-charset-prompt-value
- :action 'widget-mime-charset-action)
-
-(defun widget-mime-charset-prompt-value (widget prompt value unbound)
- ;; Read mime-charset from minibuffer.
- (intern
- (completing-read (format "%s (default %s) " prompt value)
- (mapcar (function
- (lambda (sym)
- (list (symbol-name sym))))
- (mime-charset-list)))))
-
-(defun widget-mime-charset-action (widget &optional event)
- ;; Read a mime-charset from the minibuffer.
- (let ((answer
- (widget-mime-charset-prompt-value
- widget
- (widget-apply widget :menu-tag-get)
- (widget-value widget)
- t)))
- (widget-value-set widget answer)
- (widget-apply widget :notify widget event)
- (widget-setup)))
-
-(defcustom default-mime-charset 'x-ctext
- "Default value of MIME-charset.
-It is used when MIME-charset is not specified.
-It must be symbol."
- :group 'i18n
- :type 'mime-charset)
-
-(defsubst detect-mime-charset-region (start end)
- "Return MIME charset for region between START and END."
- (charsets-to-mime-charset (find-charset-region start end)))
-
-(defun write-region-as-mime-charset (charset start end filename
- &optional append visit lockname)
- "Like `write-region', q.v., but encode by MIME CHARSET."
- (let ((coding-system-for-write
- (or (mime-charset-to-coding-system charset)
- 'binary)))
- (write-region start end filename append visit lockname)))
-
-
-;;; @ end
-;;;
-
-(provide 'emu-20)
-
-;;; emu-20.el ends here
(require 'poem)
-;;; @ MIME charset
-;;;
-
-(defsubst encode-mime-charset-region (start end charset)
- "Encode the text between START and END as MIME CHARSET."
- (let (cs)
- (if (and enable-multibyte-characters
- (setq cs (mime-charset-to-coding-system charset)))
- (encode-coding-region start end cs)
- )))
-
-(defsubst decode-mime-charset-region (start end charset &optional lbt)
- "Decode the text between START and END as MIME CHARSET."
- (let (cs)
- (if (and enable-multibyte-characters
- (setq cs (mime-charset-to-coding-system charset lbt)))
- (decode-coding-region start end cs)
- )))
-
-(defsubst encode-mime-charset-string (string charset)
- "Encode the STRING as MIME CHARSET."
- (let (cs)
- (if (and enable-multibyte-characters
- (setq cs (mime-charset-to-coding-system charset)))
- (encode-coding-string string cs)
- string)))
-
-(defsubst decode-mime-charset-string (string charset &optional lbt)
- "Decode the STRING as MIME CHARSET."
- (let (cs)
- (if (and enable-multibyte-characters
- (setq cs (mime-charset-to-coding-system charset lbt)))
- (decode-coding-string string cs)
- string)))
-
-
-(defvar charsets-mime-charset-alist
- '(((ascii) . us-ascii)
- ((ascii latin-iso8859-1) . iso-8859-1)
- ((ascii latin-iso8859-2) . iso-8859-2)
- ((ascii latin-iso8859-3) . iso-8859-3)
- ((ascii latin-iso8859-4) . iso-8859-4)
-;;; ((ascii cyrillic-iso8859-5) . iso-8859-5)
- ((ascii cyrillic-iso8859-5) . koi8-r)
- ((ascii arabic-iso8859-6) . iso-8859-6)
- ((ascii greek-iso8859-7) . iso-8859-7)
- ((ascii hebrew-iso8859-8) . iso-8859-8)
- ((ascii latin-iso8859-9) . iso-8859-9)
- ((ascii latin-jisx0201
- japanese-jisx0208-1978 japanese-jisx0208) . iso-2022-jp)
- ((ascii latin-jisx0201
- katakana-jisx0201 japanese-jisx0208) . shift_jis)
- ((ascii korean-ksc5601) . euc-kr)
- ((ascii chinese-gb2312) . cn-gb-2312)
- ((ascii chinese-big5-1 chinese-big5-2) . cn-big5)
- ((ascii latin-iso8859-1 greek-iso8859-7
- latin-jisx0201 japanese-jisx0208-1978
- chinese-gb2312 japanese-jisx0208
- korean-ksc5601 japanese-jisx0212) . iso-2022-jp-2)
- ((ascii latin-iso8859-1 greek-iso8859-7
- latin-jisx0201 japanese-jisx0208-1978
- chinese-gb2312 japanese-jisx0208
- korean-ksc5601 japanese-jisx0212
- chinese-cns11643-1 chinese-cns11643-2) . iso-2022-int-1)
- ((ascii latin-iso8859-1 latin-iso8859-2
- cyrillic-iso8859-5 greek-iso8859-7
- latin-jisx0201 japanese-jisx0208-1978
- chinese-gb2312 japanese-jisx0208
- korean-ksc5601 japanese-jisx0212
- chinese-cns11643-1 chinese-cns11643-2
- chinese-cns11643-3 chinese-cns11643-4
- chinese-cns11643-5 chinese-cns11643-6
- chinese-cns11643-7) . iso-2022-int-1)
- ))
-
-
;;; @ character
;;;
;;; @ end
;;;
-(require 'emu-20)
-
(defalias 'insert-binary-file-contents 'insert-file-contents-as-binary)
(make-obsolete 'insert-binary-file-contents 'insert-file-contents-as-binary)
(insert-file-contents-literally filename visit beg end replace)))
-;;; @ MIME charset
-;;;
-
-(defvar charsets-mime-charset-alist
- '(((ascii) . us-ascii)))
-
-(defvar default-mime-charset 'iso-8859-1)
-
-(defun mime-charset-to-coding-system (charset)
- (if (stringp charset)
- (setq charset (intern (downcase charset)))
- )
- (if (memq charset (list 'us-ascii default-mime-charset))
- charset
- ))
-
-(defun detect-mime-charset-region (start end)
- "Return MIME charset for region between START and END."
- (if (save-excursion
- (goto-char start)
- (re-search-forward "[\200-\377]" end t))
- default-mime-charset
- 'us-ascii))
-
-(defun encode-mime-charset-region (start end charset)
- "Encode the text between START and END as MIME CHARSET."
- )
-
-(defun decode-mime-charset-region (start end charset &optional lbt)
- "Decode the text between START and END as MIME CHARSET."
- (cond ((eq lbt 'CRLF)
- (save-excursion
- (save-restriction
- (narrow-to-region start end)
- (goto-char (point-min))
- (while (search-forward "\r\n" nil t)
- (replace-match "\n"))
- ))
- )))
-
-(defun encode-mime-charset-string (string charset)
- "Encode the STRING as MIME CHARSET."
- string)
-
-(defun decode-mime-charset-string (string charset &optional lbt)
- "Decode the STRING as MIME CHARSET."
- (if lbt
- (with-temp-buffer
- (insert string)
- (decode-mime-charset-region (point-min)(point-max) charset lbt)
- (buffer-string))
- string))
-
-(defalias 'write-region-as-mime-charset 'write-region)
-
-
;;; @ end
;;;
(insert-file-contents-literally filename visit beg end replace)))
-;;; @ MIME charset
-;;;
-
-(defun encode-mime-charset-region (start end charset)
- "Encode the text between START and END as MIME CHARSET."
- (let ((cs (mime-charset-to-coding-system charset)))
- (if cs
- (code-convert start end *internal* cs)
- )))
-
-(defun decode-mime-charset-region (start end charset &optional lbt)
- "Decode the text between START and END as MIME CHARSET."
- (let ((cs (mime-charset-to-coding-system charset lbt))
- newline)
- (if cs
- (code-convert start end cs *internal*)
- (if (and lbt (setq cs (mime-charset-to-coding-system charset)))
- (progn
- (if (setq newline (cdr (assq lbt '((CRLF . "\r\n") (CR . "\r")))))
- (save-excursion
- (save-restriction
- (narrow-to-region start end)
- (goto-char (point-min))
- (while (search-forward newline nil t)
- (replace-match "\n")))
- (code-convert (point-min) (point-max) cs *internal*))
- (code-convert start end cs *internal*)))))))
-
-(defun encode-mime-charset-string (string charset)
- "Encode the STRING as MIME CHARSET."
- (let ((cs (mime-charset-to-coding-system charset)))
- (if cs
- (code-convert-string string *internal* cs)
- string)))
-
-(defun decode-mime-charset-string (string charset &optional lbt)
- "Decode the STRING which is encoded in MIME CHARSET."
- (let ((cs (mime-charset-to-coding-system charset lbt))
- newline)
- (if cs
- (decode-coding-string string cs)
- (if (and lbt (setq cs (mime-charset-to-coding-system charset)))
- (progn
- (if (setq newline (cdr (assq lbt '((CRLF . "\r\n") (CR . "\r")))))
- (with-temp-buffer
- (insert string)
- (goto-char (point-min))
- (while (search-forward newline nil t)
- (replace-match "\n"))
- (code-convert (point-min) (point-max) cs *internal*)
- (buffer-string))
- (decode-coding-string string cs)))
- string))))
-
-(cond
- (running-emacs-19_29-or-later
- ;; for MULE 2.3 based on Emacs 19.34.
- (defun write-region-as-mime-charset (charset start end filename
- &optional append visit lockname)
- "Like `write-region', q.v., but code-convert by MIME CHARSET."
- (let ((file-coding-system
- (or (mime-charset-to-coding-system charset)
- *noconv*)))
- (write-region start end filename append visit lockname)))
- )
- (t
- ;; for MULE 2.3 based on Emacs 19.28.
- (defun write-region-as-mime-charset (charset start end filename
- &optional append visit lockname)
- "Like `write-region', q.v., but code-convert by MIME CHARSET."
- (let ((file-coding-system
- (or (mime-charset-to-coding-system charset)
- *noconv*)))
- (write-region start end filename append visit)))
- ))
-
-
-;;; @@ to coding-system
-;;;
-
-(require 'cyrillic)
-
-(defvar mime-charset-coding-system-alist
- '((iso-8859-1 . *ctext*)
- (x-ctext . *ctext*)
- (gb2312 . *euc-china*)
- (koi8-r . *koi8*)
- (iso-2022-jp-2 . *iso-2022-ss2-7*)
- (x-iso-2022-jp-2 . *iso-2022-ss2-7*)
- (shift_jis . *sjis*)
- (x-shiftjis . *sjis*)
- ))
-
-(defsubst mime-charset-to-coding-system (charset &optional lbt)
- (if (stringp charset)
- (setq charset (intern (downcase charset)))
- )
- (setq charset (or (cdr (assq charset mime-charset-coding-system-alist))
- (intern (concat "*" (symbol-name charset) "*"))))
- (if lbt
- (setq charset (intern (format "%s%s" charset
- (cond ((eq lbt 'CRLF) 'dos)
- ((eq lbt 'LF) 'unix)
- ((eq lbt 'CR) 'mac)
- (t lbt)))))
- )
- (if (coding-system-p charset)
- charset
- ))
-
-
-;;; @@ detection
-;;;
-
-(defvar charsets-mime-charset-alist
- (let ((alist
- '(((lc-ascii) . us-ascii)
- ((lc-ascii lc-ltn1) . iso-8859-1)
- ((lc-ascii lc-ltn2) . iso-8859-2)
- ((lc-ascii lc-ltn3) . iso-8859-3)
- ((lc-ascii lc-ltn4) . iso-8859-4)
-;;; ((lc-ascii lc-crl) . iso-8859-5)
- ((lc-ascii lc-crl) . koi8-r)
- ((lc-ascii lc-arb) . iso-8859-6)
- ((lc-ascii lc-grk) . iso-8859-7)
- ((lc-ascii lc-hbw) . iso-8859-8)
- ((lc-ascii lc-ltn5) . iso-8859-9)
- ((lc-ascii lc-roman lc-jpold lc-jp) . iso-2022-jp)
- ((lc-ascii lc-kr) . euc-kr)
- ((lc-ascii lc-cn) . gb2312)
- ((lc-ascii lc-big5-1 lc-big5-2) . big5)
- ((lc-ascii lc-roman lc-ltn1 lc-grk
- lc-jpold lc-cn lc-jp lc-kr
- lc-jp2) . iso-2022-jp-2)
- ((lc-ascii lc-roman lc-ltn1 lc-grk
- lc-jpold lc-cn lc-jp lc-kr lc-jp2
- lc-cns1 lc-cns2) . iso-2022-int-1)
- ((lc-ascii lc-roman
- lc-ltn1 lc-ltn2 lc-crl lc-grk
- lc-jpold lc-cn lc-jp lc-kr lc-jp2
- lc-cns1 lc-cns2 lc-cns3 lc-cns4
- lc-cns5 lc-cns6 lc-cns7) . iso-2022-int-1)
- ))
- dest)
- (while alist
- (catch 'not-found
- (let ((pair (car alist)))
- (setq dest
- (append dest
- (list
- (cons (mapcar (function
- (lambda (cs)
- (if (boundp cs)
- (symbol-value cs)
- (throw 'not-found nil)
- )))
- (car pair))
- (cdr pair)))))))
- (setq alist (cdr alist)))
- dest))
-
-(defvar default-mime-charset 'x-ctext
- "Default value of MIME-charset.
-It is used when MIME-charset is not specified.
-It must be symbol.")
-
-(defun detect-mime-charset-region (start end)
- "Return MIME charset for region between START and END."
- (charsets-to-mime-charset
- (cons lc-ascii (find-charset-region start end))))
-
-
;;; @ regulation
;;;
(insert-file-contents-literally filename visit beg end replace)))
-;;; @ MIME charset
-;;;
-
-(defvar charsets-mime-charset-alist
- '(((ascii) . us-ascii)))
-
-(defvar default-mime-charset 'iso-2022-jp)
-
-(defvar mime-charset-coding-system-alist
- '((iso-2022-jp . 2)
- (shift_jis . 1)
- ))
-
-(defun mime-charset-to-coding-system (charset)
- (if (stringp charset)
- (setq charset (intern (downcase charset)))
- )
- (cdr (assq charset mime-charset-coding-system-alist)))
-
-(defun detect-mime-charset-region (start end)
- "Return MIME charset for region between START and END.
-\[emu-nemacs.el]"
- (if (save-excursion
- (save-restriction
- (narrow-to-region start end)
- (goto-char start)
- (re-search-forward "[\200-\377]" nil t)))
- default-mime-charset
- 'us-ascii))
-
-(defun encode-mime-charset-region (start end charset)
- "Encode the text between START and END as MIME CHARSET.
-\[emu-nemacs.el]"
- (let ((cs (mime-charset-to-coding-system charset)))
- (and (numberp cs)
- (or (= cs 3)
- (save-excursion
- (save-restriction
- (narrow-to-region start end)
- (convert-region-kanji-code start end 3 cs))))
- )))
-
-(defun decode-mime-charset-region (start end charset &optional lbt)
- "Decode the text between START and END as MIME CHARSET.
-\[emu-nemacs.el]"
- (let ((cs (mime-charset-to-coding-system charset))
- (nl (cdr (assq lbt '((CRLF . "\r\n") (CR . "\r")
- (dos . "\r\n") (mac . "\r"))))))
- (and (numberp cs)
- (or (= cs 3)
- (save-excursion
- (save-restriction
- (narrow-to-region start end)
- (convert-region-kanji-code start end cs 3)
- (if nl
- (progn
- (goto-char (point-min))
- (while (search-forward nl nil t)
- (replace-match "\n")))
- )))
- ))))
-
-(defun encode-mime-charset-string (string charset)
- "Encode the STRING as MIME CHARSET. [emu-nemacs.el]"
- (let ((cs (mime-charset-to-coding-system charset)))
- (if cs
- (convert-string-kanji-code string 3 cs)
- string)))
-
-(defun decode-mime-charset-string (string charset &optional lbt)
- "Decode the STRING as MIME CHARSET. [emu-nemacs.el]"
- (with-temp-buffer
- (insert string)
- (decode-mime-charset-region (point-min)(point-max) charset lbt)
- (buffer-string)))
-
-(defun write-region-as-mime-charset (charset start end filename)
- "Like `write-region', q.v., but code-convert by MIME CHARSET.
-\[emu-nemacs.el]"
- (let ((kanji-fileio-code
- (or (mime-charset-to-coding-system charset)
- *noconv*)))
- (write-region start end filename)))
-
-
;;; @ end
;;;
;;; Code:
(require 'poem)
-(require 'emu-20)
;;; @ CCL
(insert-file-contents-literally filename visit beg end replace)))
-;;; @ MIME charset
-;;;
-
-(defun encode-mime-charset-region (start end charset)
- "Encode the text between START and END as MIME CHARSET."
- (let ((cs (mime-charset-to-coding-system charset)))
- (if cs
- (encode-coding-region start end cs)
- )))
-
-(defcustom mime-charset-decoder-alist
- '((iso-2022-jp . decode-mime-charset-region-with-iso646-unification)
- (iso-2022-jp-2 . decode-mime-charset-region-with-iso646-unification)
- (x-ctext . decode-mime-charset-region-with-iso646-unification)
- (hz-gb-2312 . decode-mime-charset-region-for-hz)
- (t . decode-mime-charset-region-default))
- "Alist MIME-charset vs. decoder function."
- :group 'i18n
- :type '(repeat (cons mime-charset function)))
-
-(defsubst decode-mime-charset-region-default (start end charset lbt)
- (let ((cs (mime-charset-to-coding-system charset lbt)))
- (if cs
- (decode-coding-region start end cs)
- )))
-
-(defcustom mime-iso646-character-unification-alist
- `,(let (dest
- (i 33))
- (while (< i 92)
- (setq dest
- (cons (cons (char-to-string (make-char 'latin-jisx0201 i))
- (format "%c" i))
- dest))
- (setq i (1+ i)))
- (setq i 93)
- (while (< i 126)
- (setq dest
- (cons (cons (char-to-string (make-char 'latin-jisx0201 i))
- (format "%c" i))
- dest))
- (setq i (1+ i)))
- (nreverse dest))
- "Alist unified string vs. canonical string."
- :group 'i18n
- :type '(repeat (cons string string)))
-
-(defcustom mime-unified-character-face nil
- "*Face of unified character."
- :group 'i18n
- :type 'face)
-
-(defcustom mime-character-unification-limit-size 2048
- "*Limit size to unify characters."
- :group 'i18n
- :type 'integer)
-
-(defun decode-mime-charset-region-with-iso646-unification (start end charset
- lbt)
- (decode-mime-charset-region-default start end charset lbt)
- (if (<= (- end start) mime-character-unification-limit-size)
- (save-excursion
- (let ((rest mime-iso646-character-unification-alist))
- (while rest
- (let ((pair (car rest)))
- (goto-char (point-min))
- (while (search-forward (car pair) nil t)
- (let ((str (cdr pair)))
- (put-text-property 0 (length str)
- 'face mime-unified-character-face str)
- (replace-match str 'fixed-case 'literal)
- )
- ))
- (setq rest (cdr rest)))))
- ))
-
-(defun decode-mime-charset-region-for-hz (start end charset lbt)
- (if lbt
- (save-restriction
- (narrow-to-region start end)
- (decode-coding-region (point-min)(point-max)
- (mime-charset-to-coding-system 'raw-text lbt))
- (decode-hz-region (point-min)(point-max)))
- (decode-hz-region start end)))
-
-(defun decode-mime-charset-region (start end charset &optional lbt)
- "Decode the text between START and END as MIME CHARSET."
- (if (stringp charset)
- (setq charset (intern (downcase charset)))
- )
- (let ((func (cdr (or (assq charset mime-charset-decoder-alist)
- (assq t mime-charset-decoder-alist)))))
- (funcall func start end charset lbt)))
-
-(defsubst encode-mime-charset-string (string charset)
- "Encode the STRING as MIME CHARSET."
- (let ((cs (mime-charset-to-coding-system charset)))
- (if cs
- (encode-coding-string string cs)
- string)))
-
-;; (defsubst decode-mime-charset-string (string charset)
-;; "Decode the STRING as MIME CHARSET."
-;; (let ((cs (mime-charset-to-coding-system charset)))
-;; (if cs
-;; (decode-coding-string string cs)
-;; string)))
-(defun decode-mime-charset-string (string charset &optional lbt)
- "Decode the STRING as MIME CHARSET."
- (with-temp-buffer
- (insert string)
- (decode-mime-charset-region (point-min)(point-max) charset lbt)
- (buffer-string)))
-
-
-(defvar charsets-mime-charset-alist
- '(((ascii) . us-ascii)
- ((ascii latin-iso8859-1) . iso-8859-1)
- ((ascii latin-iso8859-2) . iso-8859-2)
- ((ascii latin-iso8859-3) . iso-8859-3)
- ((ascii latin-iso8859-4) . iso-8859-4)
- ((ascii cyrillic-iso8859-5) . iso-8859-5)
-;;; ((ascii cyrillic-iso8859-5) . koi8-r)
- ((ascii arabic-iso8859-6) . iso-8859-6)
- ((ascii greek-iso8859-7) . iso-8859-7)
- ((ascii hebrew-iso8859-8) . iso-8859-8)
- ((ascii latin-iso8859-9) . iso-8859-9)
- ((ascii latin-jisx0201
- japanese-jisx0208-1978 japanese-jisx0208) . iso-2022-jp)
- ((ascii latin-jisx0201
- katakana-jisx0201 japanese-jisx0208) . shift_jis)
- ((ascii korean-ksc5601) . euc-kr)
- ((ascii chinese-gb2312) . cn-gb-2312)
- ((ascii chinese-big5-1 chinese-big5-2) . cn-big5)
- ((ascii latin-iso8859-1 greek-iso8859-7
- latin-jisx0201 japanese-jisx0208-1978
- chinese-gb2312 japanese-jisx0208
- korean-ksc5601 japanese-jisx0212) . iso-2022-jp-2)
- ((ascii latin-iso8859-1 greek-iso8859-7
- latin-jisx0201 japanese-jisx0208-1978
- chinese-gb2312 japanese-jisx0208
- korean-ksc5601 japanese-jisx0212
- chinese-cns11643-1 chinese-cns11643-2) . iso-2022-int-1)
- ((ascii latin-iso8859-1 latin-iso8859-2
- cyrillic-iso8859-5 greek-iso8859-7
- latin-jisx0201 japanese-jisx0208-1978
- chinese-gb2312 japanese-jisx0208
- korean-ksc5601 japanese-jisx0212
- chinese-cns11643-1 chinese-cns11643-2
- chinese-cns11643-3 chinese-cns11643-4
- chinese-cns11643-5 chinese-cns11643-6
- chinese-cns11643-7) . iso-2022-int-1)
- ))
-
-
;;; @ character
;;;
))
(require 'poem)
+(require 'mcharset)
(cond (running-xemacs
(if (featurep 'mule)
--- /dev/null
+;;; mcharset.el --- MIME charset API
+
+;; Copyright (C) 1997,1998 Free Software Foundation, Inc.
+
+;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Keywords: emulation, compatibility, Mule
+
+;; This file is part of APEL (A Portable Emacs Library).
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(require 'poe)
+
+(cond ((featurep 'mule)
+ (cond ((featurep 'xemacs)
+ (require 'mcs-xm)
+ )
+ ((>= emacs-major-version 20)
+ (require 'mcs-e20)
+ )
+ (t
+ ;; for MULE 1.* and 2.*
+ (require 'mcs-om)
+ ))
+ )
+ ((boundp 'NEMACS)
+ ;; for Nemacs and Nepoch
+ (require 'mcs-nemacs)
+ )
+ (t
+ (require 'mcs-latin1)
+ ))
+
+
+;;; @ end
+;;;
+
+(provide 'mcharset)
+
+;;; mcharset.el ends here
--- /dev/null
+;;; mcs-20.el --- MIME charset implementation for Emacs 20 and XEmacs/mule
+
+;; Copyright (C) 1997,1998 Free Software Foundation, Inc.
+
+;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Keywords: emulation, compatibility, Mule
+
+;; This file is part of APEL (A Portable Emacs Library).
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This module requires Emacs 20.0.93, XEmacs 20.3-b5 (with mule)
+;; or later.
+
+;;; Code:
+
+(require 'poem)
+(require 'custom)
+(eval-when-compile (require 'wid-edit))
+
+
+;;; @ MIME charset
+;;;
+
+(defcustom mime-charset-coding-system-alist
+ `,(let ((rest
+ '((us-ascii . raw-text)
+ (gb2312 . cn-gb-2312)
+ (iso-2022-jp-2 . iso-2022-7bit-ss2)
+ (x-ctext . ctext)
+ (unknown . undecided)
+ (x-unknown . undecided)
+ ))
+ dest)
+ (while rest
+ (let ((pair (car rest)))
+ (or (find-coding-system (car pair))
+ (setq dest (cons pair dest))
+ ))
+ (setq rest (cdr rest))
+ )
+ dest)
+ "Alist MIME CHARSET vs CODING-SYSTEM.
+MIME CHARSET and CODING-SYSTEM must be symbol."
+ :group 'i18n
+ :type '(repeat (cons symbol coding-system)))
+
+(defsubst mime-charset-to-coding-system (charset &optional lbt)
+ "Return coding-system corresponding with CHARSET.
+CHARSET is a symbol whose name is MIME charset.
+If optional argument LBT (`CRLF', `LF', `CR', `unix', `dos' or `mac')
+is specified, it is used as line break code type of coding-system."
+ (if (stringp charset)
+ (setq charset (intern (downcase charset)))
+ )
+ (let ((ret (assq charset mime-charset-coding-system-alist)))
+ (if ret
+ (setq charset (cdr ret))
+ ))
+ (if lbt
+ (setq charset (intern (format "%s-%s" charset
+ (cond ((eq lbt 'CRLF) 'dos)
+ ((eq lbt 'LF) 'unix)
+ ((eq lbt 'CR) 'mac)
+ (t lbt)))))
+ )
+ (if (find-coding-system charset)
+ charset
+ ))
+
+(defsubst mime-charset-list ()
+ "Return a list of all existing MIME-charset."
+ (nconc (mapcar (function car) mime-charset-coding-system-alist)
+ (coding-system-list)))
+
+
+(defvar widget-mime-charset-prompt-value-history nil
+ "History of input to `widget-mime-charset-prompt-value'.")
+
+(define-widget 'mime-charset 'coding-system
+ "A mime-charset."
+ :format "%{%t%}: %v"
+ :tag "MIME-charset"
+ :prompt-history 'widget-mime-charset-prompt-value-history
+ :prompt-value 'widget-mime-charset-prompt-value
+ :action 'widget-mime-charset-action)
+
+(defun widget-mime-charset-prompt-value (widget prompt value unbound)
+ ;; Read mime-charset from minibuffer.
+ (intern
+ (completing-read (format "%s (default %s) " prompt value)
+ (mapcar (function
+ (lambda (sym)
+ (list (symbol-name sym))))
+ (mime-charset-list)))))
+
+(defun widget-mime-charset-action (widget &optional event)
+ ;; Read a mime-charset from the minibuffer.
+ (let ((answer
+ (widget-mime-charset-prompt-value
+ widget
+ (widget-apply widget :menu-tag-get)
+ (widget-value widget)
+ t)))
+ (widget-value-set widget answer)
+ (widget-apply widget :notify widget event)
+ (widget-setup)))
+
+(defcustom default-mime-charset 'x-ctext
+ "Default value of MIME-charset.
+It is used when MIME-charset is not specified.
+It must be symbol."
+ :group 'i18n
+ :type 'mime-charset)
+
+(defsubst detect-mime-charset-region (start end)
+ "Return MIME charset for region between START and END."
+ (charsets-to-mime-charset (find-charset-region start end)))
+
+(defun write-region-as-mime-charset (charset start end filename
+ &optional append visit lockname)
+ "Like `write-region', q.v., but encode by MIME CHARSET."
+ (let ((coding-system-for-write
+ (or (mime-charset-to-coding-system charset)
+ 'binary)))
+ (write-region start end filename append visit lockname)))
+
+
+;;; @ end
+;;;
+
+(provide 'mcs-20)
+
+;;; mcs-20.el ends here
--- /dev/null
+;;; mcs-e20.el --- MIME charset implementation for Emacs 20.1 and 20.2
+
+;; Copyright (C) 1996,1997,1998 Free Software Foundation, Inc.
+
+;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Keywords: emulation, compatibility, Mule
+
+;; This file is part of APEL (A Portable Emacs Library).
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This module requires Emacs 20.1 and 20.2.
+
+;;; Code:
+
+(defsubst encode-mime-charset-region (start end charset)
+ "Encode the text between START and END as MIME CHARSET."
+ (let (cs)
+ (if (and enable-multibyte-characters
+ (setq cs (mime-charset-to-coding-system charset)))
+ (encode-coding-region start end cs)
+ )))
+
+(defsubst decode-mime-charset-region (start end charset &optional lbt)
+ "Decode the text between START and END as MIME CHARSET."
+ (let (cs)
+ (if (and enable-multibyte-characters
+ (setq cs (mime-charset-to-coding-system charset lbt)))
+ (decode-coding-region start end cs)
+ )))
+
+
+(defsubst encode-mime-charset-string (string charset)
+ "Encode the STRING as MIME CHARSET."
+ (let (cs)
+ (if (and enable-multibyte-characters
+ (setq cs (mime-charset-to-coding-system charset)))
+ (encode-coding-string string cs)
+ string)))
+
+(defsubst decode-mime-charset-string (string charset &optional lbt)
+ "Decode the STRING as MIME CHARSET."
+ (let (cs)
+ (if (and enable-multibyte-characters
+ (setq cs (mime-charset-to-coding-system charset lbt)))
+ (decode-coding-string string cs)
+ string)))
+
+
+(defvar charsets-mime-charset-alist
+ '(((ascii) . us-ascii)
+ ((ascii latin-iso8859-1) . iso-8859-1)
+ ((ascii latin-iso8859-2) . iso-8859-2)
+ ((ascii latin-iso8859-3) . iso-8859-3)
+ ((ascii latin-iso8859-4) . iso-8859-4)
+;;; ((ascii cyrillic-iso8859-5) . iso-8859-5)
+ ((ascii cyrillic-iso8859-5) . koi8-r)
+ ((ascii arabic-iso8859-6) . iso-8859-6)
+ ((ascii greek-iso8859-7) . iso-8859-7)
+ ((ascii hebrew-iso8859-8) . iso-8859-8)
+ ((ascii latin-iso8859-9) . iso-8859-9)
+ ((ascii latin-jisx0201
+ japanese-jisx0208-1978 japanese-jisx0208) . iso-2022-jp)
+ ((ascii latin-jisx0201
+ katakana-jisx0201 japanese-jisx0208) . shift_jis)
+ ((ascii korean-ksc5601) . euc-kr)
+ ((ascii chinese-gb2312) . cn-gb-2312)
+ ((ascii chinese-big5-1 chinese-big5-2) . cn-big5)
+ ((ascii latin-iso8859-1 greek-iso8859-7
+ latin-jisx0201 japanese-jisx0208-1978
+ chinese-gb2312 japanese-jisx0208
+ korean-ksc5601 japanese-jisx0212) . iso-2022-jp-2)
+ ((ascii latin-iso8859-1 greek-iso8859-7
+ latin-jisx0201 japanese-jisx0208-1978
+ chinese-gb2312 japanese-jisx0208
+ korean-ksc5601 japanese-jisx0212
+ chinese-cns11643-1 chinese-cns11643-2) . iso-2022-int-1)
+ ((ascii latin-iso8859-1 latin-iso8859-2
+ cyrillic-iso8859-5 greek-iso8859-7
+ latin-jisx0201 japanese-jisx0208-1978
+ chinese-gb2312 japanese-jisx0208
+ korean-ksc5601 japanese-jisx0212
+ chinese-cns11643-1 chinese-cns11643-2
+ chinese-cns11643-3 chinese-cns11643-4
+ chinese-cns11643-5 chinese-cns11643-6
+ chinese-cns11643-7) . iso-2022-int-1)
+ ))
+
+
+;;; @ end
+;;;
+
+(require 'mcs-20)
+
+(provide 'mcs-e20)
+
+;;; mcs-e20.el ends here
--- /dev/null
+;;; mcs-ltn1.el --- MIME charset implementation for Emacs 19
+;;; and XEmacs without MULE
+
+;; Copyright (C) 1995,1996,1997,1998 MORIOKA Tomohiko
+
+;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Keywords: emulation, compatibility, Mule
+
+;; This file is part of APEL (A Portable Emacs Library).
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(defvar charsets-mime-charset-alist
+ '(((ascii) . us-ascii)))
+
+(defvar default-mime-charset 'iso-8859-1)
+
+(defun mime-charset-to-coding-system (charset)
+ (if (stringp charset)
+ (setq charset (intern (downcase charset)))
+ )
+ (if (memq charset (list 'us-ascii default-mime-charset))
+ charset
+ ))
+
+(defun detect-mime-charset-region (start end)
+ "Return MIME charset for region between START and END."
+ (if (save-excursion
+ (goto-char start)
+ (re-search-forward "[\200-\377]" end t))
+ default-mime-charset
+ 'us-ascii))
+
+(defun encode-mime-charset-region (start end charset)
+ "Encode the text between START and END as MIME CHARSET."
+ )
+
+(defun decode-mime-charset-region (start end charset &optional lbt)
+ "Decode the text between START and END as MIME CHARSET."
+ (cond ((eq lbt 'CRLF)
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char (point-min))
+ (while (search-forward "\r\n" nil t)
+ (replace-match "\n"))
+ ))
+ )))
+
+(defun encode-mime-charset-string (string charset)
+ "Encode the STRING as MIME CHARSET."
+ string)
+
+(defun decode-mime-charset-string (string charset &optional lbt)
+ "Decode the STRING as MIME CHARSET."
+ (if lbt
+ (with-temp-buffer
+ (insert string)
+ (decode-mime-charset-region (point-min)(point-max) charset lbt)
+ (buffer-string))
+ string))
+
+(defalias 'write-region-as-mime-charset 'write-region)
+
+
+;;; @ end
+;;;
+
+(provide 'mcs-ltn1)
+
+;;; mcs-ltn1.el ends here
--- /dev/null
+;;; mcs-nemacs.el --- MIME charset implementation for Nemacs
+
+;; Copyright (C) 1995,1996,1997,1998 MORIOKA Tomohiko
+
+;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Keywords: emulation, compatibility, Mule
+
+;; This file is part of APEL (A Portable Emacs Library).
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(defvar charsets-mime-charset-alist
+ '(((ascii) . us-ascii)))
+
+(defvar default-mime-charset 'iso-2022-jp)
+
+(defvar mime-charset-coding-system-alist
+ '((iso-2022-jp . 2)
+ (shift_jis . 1)
+ ))
+
+(defun mime-charset-to-coding-system (charset)
+ (if (stringp charset)
+ (setq charset (intern (downcase charset)))
+ )
+ (cdr (assq charset mime-charset-coding-system-alist)))
+
+(defun detect-mime-charset-region (start end)
+ "Return MIME charset for region between START and END.
+\[emu-nemacs.el]"
+ (if (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char start)
+ (re-search-forward "[\200-\377]" nil t)))
+ default-mime-charset
+ 'us-ascii))
+
+(defun encode-mime-charset-region (start end charset)
+ "Encode the text between START and END as MIME CHARSET.
+\[emu-nemacs.el]"
+ (let ((cs (mime-charset-to-coding-system charset)))
+ (and (numberp cs)
+ (or (= cs 3)
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (convert-region-kanji-code start end 3 cs))))
+ )))
+
+(defun decode-mime-charset-region (start end charset &optional lbt)
+ "Decode the text between START and END as MIME CHARSET.
+\[emu-nemacs.el]"
+ (let ((cs (mime-charset-to-coding-system charset))
+ (nl (cdr (assq lbt '((CRLF . "\r\n") (CR . "\r")
+ (dos . "\r\n") (mac . "\r"))))))
+ (and (numberp cs)
+ (or (= cs 3)
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (convert-region-kanji-code start end cs 3)
+ (if nl
+ (progn
+ (goto-char (point-min))
+ (while (search-forward nl nil t)
+ (replace-match "\n")))
+ )))
+ ))))
+
+(defun encode-mime-charset-string (string charset)
+ "Encode the STRING as MIME CHARSET. [emu-nemacs.el]"
+ (let ((cs (mime-charset-to-coding-system charset)))
+ (if cs
+ (convert-string-kanji-code string 3 cs)
+ string)))
+
+(defun decode-mime-charset-string (string charset &optional lbt)
+ "Decode the STRING as MIME CHARSET. [emu-nemacs.el]"
+ (with-temp-buffer
+ (insert string)
+ (decode-mime-charset-region (point-min)(point-max) charset lbt)
+ (buffer-string)))
+
+(defun write-region-as-mime-charset (charset start end filename)
+ "Like `write-region', q.v., but code-convert by MIME CHARSET.
+\[emu-nemacs.el]"
+ (let ((kanji-fileio-code
+ (or (mime-charset-to-coding-system charset) 0)))
+ (write-region start end filename)))
+
+
+;;; @ end
+;;;
+
+(provide 'mcs-nemacs)
+
+;;; mcs-nemacs.el ends here
--- /dev/null
+;;; mcs-om.el --- MIME charset implementation for Mule 1.* and Mule 2.*
+
+;; Copyright (C) 1995,1996,1997,1998 MORIOKA Tomohiko
+
+;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Keywords: emulation, compatibility, Mule
+
+;; This file is part of APEL (A Portable Emacs Library).
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(require 'poem)
+
+(defun encode-mime-charset-region (start end charset)
+ "Encode the text between START and END as MIME CHARSET."
+ (let ((cs (mime-charset-to-coding-system charset)))
+ (if cs
+ (code-convert start end *internal* cs)
+ )))
+
+(defun decode-mime-charset-region (start end charset &optional lbt)
+ "Decode the text between START and END as MIME CHARSET."
+ (let ((cs (mime-charset-to-coding-system charset lbt))
+ newline)
+ (if cs
+ (code-convert start end cs *internal*)
+ (if (and lbt (setq cs (mime-charset-to-coding-system charset)))
+ (progn
+ (if (setq newline (cdr (assq lbt '((CRLF . "\r\n") (CR . "\r")))))
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char (point-min))
+ (while (search-forward newline nil t)
+ (replace-match "\n")))
+ (code-convert (point-min) (point-max) cs *internal*))
+ (code-convert start end cs *internal*)))))))
+
+(defun encode-mime-charset-string (string charset)
+ "Encode the STRING as MIME CHARSET."
+ (let ((cs (mime-charset-to-coding-system charset)))
+ (if cs
+ (code-convert-string string *internal* cs)
+ string)))
+
+(defun decode-mime-charset-string (string charset &optional lbt)
+ "Decode the STRING which is encoded in MIME CHARSET."
+ (let ((cs (mime-charset-to-coding-system charset lbt))
+ newline)
+ (if cs
+ (decode-coding-string string cs)
+ (if (and lbt (setq cs (mime-charset-to-coding-system charset)))
+ (progn
+ (if (setq newline (cdr (assq lbt '((CRLF . "\r\n") (CR . "\r")))))
+ (with-temp-buffer
+ (insert string)
+ (goto-char (point-min))
+ (while (search-forward newline nil t)
+ (replace-match "\n"))
+ (code-convert (point-min) (point-max) cs *internal*)
+ (buffer-string))
+ (decode-coding-string string cs)))
+ string))))
+
+(cond
+ (running-emacs-19_29-or-later
+ ;; for MULE 2.3 based on Emacs 19.34.
+ (defun write-region-as-mime-charset (charset start end filename
+ &optional append visit lockname)
+ "Like `write-region', q.v., but code-convert by MIME CHARSET."
+ (let ((file-coding-system
+ (or (mime-charset-to-coding-system charset)
+ *noconv*)))
+ (write-region start end filename append visit lockname)))
+ )
+ (t
+ ;; for MULE 2.3 based on Emacs 19.28.
+ (defun write-region-as-mime-charset (charset start end filename
+ &optional append visit lockname)
+ "Like `write-region', q.v., but code-convert by MIME CHARSET."
+ (let ((file-coding-system
+ (or (mime-charset-to-coding-system charset)
+ *noconv*)))
+ (write-region start end filename append visit)))
+ ))
+
+
+;;; @ to coding-system
+;;;
+
+(require 'cyrillic)
+
+(defvar mime-charset-coding-system-alist
+ '((iso-8859-1 . *ctext*)
+ (x-ctext . *ctext*)
+ (gb2312 . *euc-china*)
+ (koi8-r . *koi8*)
+ (iso-2022-jp-2 . *iso-2022-ss2-7*)
+ (x-iso-2022-jp-2 . *iso-2022-ss2-7*)
+ (shift_jis . *sjis*)
+ (x-shiftjis . *sjis*)
+ ))
+
+(defsubst mime-charset-to-coding-system (charset &optional lbt)
+ (if (stringp charset)
+ (setq charset (intern (downcase charset)))
+ )
+ (setq charset (or (cdr (assq charset mime-charset-coding-system-alist))
+ (intern (concat "*" (symbol-name charset) "*"))))
+ (if lbt
+ (setq charset (intern (format "%s%s" charset
+ (cond ((eq lbt 'CRLF) 'dos)
+ ((eq lbt 'LF) 'unix)
+ ((eq lbt 'CR) 'mac)
+ (t lbt)))))
+ )
+ (if (coding-system-p charset)
+ charset
+ ))
+
+
+;;; @ detection
+;;;
+
+(defvar charsets-mime-charset-alist
+ (let ((alist
+ '(((lc-ascii) . us-ascii)
+ ((lc-ascii lc-ltn1) . iso-8859-1)
+ ((lc-ascii lc-ltn2) . iso-8859-2)
+ ((lc-ascii lc-ltn3) . iso-8859-3)
+ ((lc-ascii lc-ltn4) . iso-8859-4)
+;;; ((lc-ascii lc-crl) . iso-8859-5)
+ ((lc-ascii lc-crl) . koi8-r)
+ ((lc-ascii lc-arb) . iso-8859-6)
+ ((lc-ascii lc-grk) . iso-8859-7)
+ ((lc-ascii lc-hbw) . iso-8859-8)
+ ((lc-ascii lc-ltn5) . iso-8859-9)
+ ((lc-ascii lc-roman lc-jpold lc-jp) . iso-2022-jp)
+ ((lc-ascii lc-kr) . euc-kr)
+ ((lc-ascii lc-cn) . gb2312)
+ ((lc-ascii lc-big5-1 lc-big5-2) . big5)
+ ((lc-ascii lc-roman lc-ltn1 lc-grk
+ lc-jpold lc-cn lc-jp lc-kr
+ lc-jp2) . iso-2022-jp-2)
+ ((lc-ascii lc-roman lc-ltn1 lc-grk
+ lc-jpold lc-cn lc-jp lc-kr lc-jp2
+ lc-cns1 lc-cns2) . iso-2022-int-1)
+ ((lc-ascii lc-roman
+ lc-ltn1 lc-ltn2 lc-crl lc-grk
+ lc-jpold lc-cn lc-jp lc-kr lc-jp2
+ lc-cns1 lc-cns2 lc-cns3 lc-cns4
+ lc-cns5 lc-cns6 lc-cns7) . iso-2022-int-1)
+ ))
+ dest)
+ (while alist
+ (catch 'not-found
+ (let ((pair (car alist)))
+ (setq dest
+ (append dest
+ (list
+ (cons (mapcar (function
+ (lambda (cs)
+ (if (boundp cs)
+ (symbol-value cs)
+ (throw 'not-found nil)
+ )))
+ (car pair))
+ (cdr pair)))))))
+ (setq alist (cdr alist)))
+ dest))
+
+(defvar default-mime-charset 'x-ctext
+ "Default value of MIME-charset.
+It is used when MIME-charset is not specified.
+It must be symbol.")
+
+(defun detect-mime-charset-region (start end)
+ "Return MIME charset for region between START and END."
+ (charsets-to-mime-charset
+ (cons lc-ascii (find-charset-region start end))))
+
+
+;;; @ end
+;;;
+
+(provide 'mcs-om)
+
+;;; mcs-om.el ends here
--- /dev/null
+;;; mcs-xm.el --- MIME charset implementation for XEmacs-mule
+
+;; Copyright (C) 1997,1998 Free Software Foundation, Inc.
+
+;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Keywords: emulation, compatibility, Mule
+
+;; This file is part of APEL (A Portable Emacs Library).
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This module requires Emacs 20.0.93, XEmacs 20.3-b5 (with mule)
+;; or later.
+
+;;; Code:
+
+(require 'mcs-20)
+
+
+(defun encode-mime-charset-region (start end charset)
+ "Encode the text between START and END as MIME CHARSET."
+ (let ((cs (mime-charset-to-coding-system charset)))
+ (if cs
+ (encode-coding-region start end cs)
+ )))
+
+
+(defcustom mime-charset-decoder-alist
+ '((iso-2022-jp . decode-mime-charset-region-with-iso646-unification)
+ (iso-2022-jp-2 . decode-mime-charset-region-with-iso646-unification)
+ (x-ctext . decode-mime-charset-region-with-iso646-unification)
+ (hz-gb-2312 . decode-mime-charset-region-for-hz)
+ (t . decode-mime-charset-region-default))
+ "Alist MIME-charset vs. decoder function."
+ :group 'i18n
+ :type '(repeat (cons mime-charset function)))
+
+(defsubst decode-mime-charset-region-default (start end charset lbt)
+ (let ((cs (mime-charset-to-coding-system charset lbt)))
+ (if cs
+ (decode-coding-region start end cs)
+ )))
+
+(defcustom mime-iso646-character-unification-alist
+ `,(let (dest
+ (i 33))
+ (while (< i 92)
+ (setq dest
+ (cons (cons (char-to-string (make-char 'latin-jisx0201 i))
+ (format "%c" i))
+ dest))
+ (setq i (1+ i)))
+ (setq i 93)
+ (while (< i 126)
+ (setq dest
+ (cons (cons (char-to-string (make-char 'latin-jisx0201 i))
+ (format "%c" i))
+ dest))
+ (setq i (1+ i)))
+ (nreverse dest))
+ "Alist unified string vs. canonical string."
+ :group 'i18n
+ :type '(repeat (cons string string)))
+
+(defcustom mime-unified-character-face nil
+ "*Face of unified character."
+ :group 'i18n
+ :type 'face)
+
+(defcustom mime-character-unification-limit-size 2048
+ "*Limit size to unify characters."
+ :group 'i18n
+ :type 'integer)
+
+(defun decode-mime-charset-region-with-iso646-unification (start end charset
+ lbt)
+ (decode-mime-charset-region-default start end charset lbt)
+ (if (<= (- end start) mime-character-unification-limit-size)
+ (save-excursion
+ (let ((rest mime-iso646-character-unification-alist))
+ (while rest
+ (let ((pair (car rest)))
+ (goto-char (point-min))
+ (while (search-forward (car pair) nil t)
+ (let ((str (cdr pair)))
+ (put-text-property 0 (length str)
+ 'face mime-unified-character-face str)
+ (replace-match str 'fixed-case 'literal)
+ )
+ ))
+ (setq rest (cdr rest)))))
+ ))
+
+(defun decode-mime-charset-region-for-hz (start end charset lbt)
+ (if lbt
+ (save-restriction
+ (narrow-to-region start end)
+ (decode-coding-region (point-min)(point-max)
+ (mime-charset-to-coding-system 'raw-text lbt))
+ (decode-hz-region (point-min)(point-max)))
+ (decode-hz-region start end)))
+
+(defun decode-mime-charset-region (start end charset &optional lbt)
+ "Decode the text between START and END as MIME CHARSET."
+ (if (stringp charset)
+ (setq charset (intern (downcase charset)))
+ )
+ (let ((func (cdr (or (assq charset mime-charset-decoder-alist)
+ (assq t mime-charset-decoder-alist)))))
+ (funcall func start end charset lbt)))
+
+(defsubst encode-mime-charset-string (string charset)
+ "Encode the STRING as MIME CHARSET."
+ (let ((cs (mime-charset-to-coding-system charset)))
+ (if cs
+ (encode-coding-string string cs)
+ string)))
+
+;; (defsubst decode-mime-charset-string (string charset)
+;; "Decode the STRING as MIME CHARSET."
+;; (let ((cs (mime-charset-to-coding-system charset)))
+;; (if cs
+;; (decode-coding-string string cs)
+;; string)))
+(defun decode-mime-charset-string (string charset &optional lbt)
+ "Decode the STRING as MIME CHARSET."
+ (with-temp-buffer
+ (insert string)
+ (decode-mime-charset-region (point-min)(point-max) charset lbt)
+ (buffer-string)))
+
+
+(defvar charsets-mime-charset-alist
+ '(((ascii) . us-ascii)
+ ((ascii latin-iso8859-1) . iso-8859-1)
+ ((ascii latin-iso8859-2) . iso-8859-2)
+ ((ascii latin-iso8859-3) . iso-8859-3)
+ ((ascii latin-iso8859-4) . iso-8859-4)
+ ((ascii cyrillic-iso8859-5) . iso-8859-5)
+;;; ((ascii cyrillic-iso8859-5) . koi8-r)
+ ((ascii arabic-iso8859-6) . iso-8859-6)
+ ((ascii greek-iso8859-7) . iso-8859-7)
+ ((ascii hebrew-iso8859-8) . iso-8859-8)
+ ((ascii latin-iso8859-9) . iso-8859-9)
+ ((ascii latin-jisx0201
+ japanese-jisx0208-1978 japanese-jisx0208) . iso-2022-jp)
+ ((ascii latin-jisx0201
+ katakana-jisx0201 japanese-jisx0208) . shift_jis)
+ ((ascii korean-ksc5601) . euc-kr)
+ ((ascii chinese-gb2312) . cn-gb-2312)
+ ((ascii chinese-big5-1 chinese-big5-2) . cn-big5)
+ ((ascii latin-iso8859-1 greek-iso8859-7
+ latin-jisx0201 japanese-jisx0208-1978
+ chinese-gb2312 japanese-jisx0208
+ korean-ksc5601 japanese-jisx0212) . iso-2022-jp-2)
+ ((ascii latin-iso8859-1 greek-iso8859-7
+ latin-jisx0201 japanese-jisx0208-1978
+ chinese-gb2312 japanese-jisx0208
+ korean-ksc5601 japanese-jisx0212
+ chinese-cns11643-1 chinese-cns11643-2) . iso-2022-int-1)
+ ((ascii latin-iso8859-1 latin-iso8859-2
+ cyrillic-iso8859-5 greek-iso8859-7
+ latin-jisx0201 japanese-jisx0208-1978
+ chinese-gb2312 japanese-jisx0208
+ korean-ksc5601 japanese-jisx0212
+ chinese-cns11643-1 chinese-cns11643-2
+ chinese-cns11643-3 chinese-cns11643-4
+ chinese-cns11643-5 chinese-cns11643-6
+ chinese-cns11643-7) . iso-2022-int-1)
+ ))
+
+
+;;; @ end
+;;;
+
+(provide 'mcs-xm)
+
+;;; mcs-xm.el ends here
projects / elisp / apel.git / commitdiff