From: morioka Date: Thu, 17 Sep 1998 13:42:59 +0000 (+0000) Subject: - Rename emu-20.el to mcs-20.el. X-Git-Tag: poe-199811302358~41 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=e78abef24860bee3c828474220e276baabe30313;p=elisp%2Fapel.git - Rename emu-20.el to mcs-20.el. - Split core about MIME charset from emu to mcharset. --- diff --git a/EMU-ELS b/EMU-ELS index 34ba355..1e4484f 100644 --- a/EMU-ELS +++ b/EMU-ELS @@ -4,7 +4,7 @@ ;;; Code: -(setq emu-modules '(poe poem emu)) +(setq emu-modules '(poe poem mcharset emu)) (setq emu-modules (nconc @@ -13,9 +13,9 @@ (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 @@ -25,22 +25,22 @@ '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)) diff --git a/emu-20.el b/emu-20.el deleted file mode 100644 index 52b0bfb..0000000 --- a/emu-20.el +++ /dev/null @@ -1,149 +0,0 @@ -;;; emu-20.el --- emu API implementation for Emacs 20 and XEmacs/mule - -;; Copyright (C) 1997,1998 Free Software Foundation, Inc. - -;; Author: MORIOKA Tomohiko -;; 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 diff --git a/emu-e20.el b/emu-e20.el index 694a36b..6c43b07 100644 --- a/emu-e20.el +++ b/emu-e20.el @@ -31,82 +31,6 @@ (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 ;;; @@ -228,8 +152,6 @@ If CCL-PROG is symbol, it is dereferenced. ;;; @ 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) diff --git a/emu-latin1.el b/emu-latin1.el index 4dc6acd..f184cfa 100644 --- a/emu-latin1.el +++ b/emu-latin1.el @@ -68,62 +68,6 @@ find-file-hooks, etc. (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 ;;; diff --git a/emu-mule.el b/emu-mule.el index bb6911b..2f6f107 100644 --- a/emu-mule.el +++ b/emu-mule.el @@ -46,178 +46,6 @@ find-file-hooks, etc. (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 ;;; diff --git a/emu-nemacs.el b/emu-nemacs.el index f9be5f6..087bbfa 100644 --- a/emu-nemacs.el +++ b/emu-nemacs.el @@ -78,91 +78,6 @@ find-file-hooks, etc. (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 ;;; diff --git a/emu-x20.el b/emu-x20.el index 89daac9..8703ab0 100644 --- a/emu-x20.el +++ b/emu-x20.el @@ -29,7 +29,6 @@ ;;; Code: (require 'poem) -(require 'emu-20) ;;; @ CCL @@ -61,161 +60,6 @@ find-file-hooks, etc. (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 ;;; diff --git a/emu.el b/emu.el index a026678..fefc390 100644 --- a/emu.el +++ b/emu.el @@ -75,6 +75,7 @@ )) (require 'poem) +(require 'mcharset) (cond (running-xemacs (if (featurep 'mule) diff --git a/mcharset.el b/mcharset.el new file mode 100644 index 0000000..dbfa024 --- /dev/null +++ b/mcharset.el @@ -0,0 +1,55 @@ +;;; mcharset.el --- MIME charset API + +;; Copyright (C) 1997,1998 Free Software Foundation, Inc. + +;; Author: MORIOKA Tomohiko +;; 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 diff --git a/mcs-20.el b/mcs-20.el new file mode 100644 index 0000000..55faf50 --- /dev/null +++ b/mcs-20.el @@ -0,0 +1,149 @@ +;;; mcs-20.el --- MIME charset implementation for Emacs 20 and XEmacs/mule + +;; Copyright (C) 1997,1998 Free Software Foundation, Inc. + +;; Author: MORIOKA Tomohiko +;; 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 diff --git a/mcs-e20.el b/mcs-e20.el new file mode 100644 index 0000000..c452f15 --- /dev/null +++ b/mcs-e20.el @@ -0,0 +1,112 @@ +;;; 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 +;; 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 diff --git a/mcs-ltn1.el b/mcs-ltn1.el new file mode 100644 index 0000000..2fed09a --- /dev/null +++ b/mcs-ltn1.el @@ -0,0 +1,86 @@ +;;; mcs-ltn1.el --- MIME charset implementation for Emacs 19 +;;; and XEmacs without MULE + +;; Copyright (C) 1995,1996,1997,1998 MORIOKA Tomohiko + +;; Author: MORIOKA Tomohiko +;; 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 diff --git a/mcs-nemacs.el b/mcs-nemacs.el new file mode 100644 index 0000000..c32fd6f --- /dev/null +++ b/mcs-nemacs.el @@ -0,0 +1,113 @@ +;;; mcs-nemacs.el --- MIME charset implementation for Nemacs + +;; Copyright (C) 1995,1996,1997,1998 MORIOKA Tomohiko + +;; Author: MORIOKA Tomohiko +;; 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 diff --git a/mcs-om.el b/mcs-om.el new file mode 100644 index 0000000..433262d --- /dev/null +++ b/mcs-om.el @@ -0,0 +1,203 @@ +;;; mcs-om.el --- MIME charset implementation for Mule 1.* and Mule 2.* + +;; Copyright (C) 1995,1996,1997,1998 MORIOKA Tomohiko + +;; Author: MORIOKA Tomohiko +;; 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 diff --git a/mcs-xm.el b/mcs-xm.el new file mode 100644 index 0000000..b280ac0 --- /dev/null +++ b/mcs-xm.el @@ -0,0 +1,193 @@ +;;; mcs-xm.el --- MIME charset implementation for XEmacs-mule + +;; Copyright (C) 1997,1998 Free Software Foundation, Inc. + +;; Author: MORIOKA Tomohiko +;; 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