From d273587fc442fd73783bcd01817a89a0f5a182e8 Mon Sep 17 00:00:00 2001 From: morioka Date: Fri, 24 Apr 1998 19:12:39 +0000 Subject: [PATCH] Merge apel-unify-8_4_1. --- APEL-ELS | 2 +- README.en | 1 - emu-x20.el | 85 +++++++++++++++++++++++++++++++++++++++++++++++++++++++----- 3 files changed, 79 insertions(+), 9 deletions(-) diff --git a/APEL-ELS b/APEL-ELS index 02cab0a..46a44cc 100644 --- a/APEL-ELS +++ b/APEL-ELS @@ -1,6 +1,6 @@ ;;; -*-Emacs-Lisp-*- ;;; -;;; $Id: APEL-ELS,v 1.8 1998-04-10 15:06:43 morioka Exp $ +;;; $Id: APEL-ELS,v 1.9 1998-04-24 19:12:39 morioka Exp $ ;;; (setq apel-modules '(alist calist atype diff --git a/README.en b/README.en index 64d0a43..9f6fa61 100644 --- a/README.en +++ b/README.en @@ -1,6 +1,5 @@ [README for APEL (English Version)] by MORIOKA Tomohiko -$Id: README.en,v 1.11 1998-04-17 07:39:49 morioka Exp $ What's APEL? ============ diff --git a/emu-x20.el b/emu-x20.el index 2b41be0..1c06239 100644 --- a/emu-x20.el +++ b/emu-x20.el @@ -77,13 +77,77 @@ find-file-hooks, etc. (encode-coding-region start end cs) ))) -(defun decode-mime-charset-region (start end charset) - "Decode the text between START and END as MIME CHARSET." +(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) (let ((cs (mime-charset-to-coding-system charset))) (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) + +(defun decode-mime-charset-region-with-iso646-unification (start end charset) + (decode-mime-charset-region-default start end charset) + (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) + (decode-hz-region start end)) + +(defun decode-mime-charset-region (start end charset) + "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) + )) + (defsubst encode-mime-charset-string (string charset) "Encode the STRING as MIME CHARSET." (let ((cs (mime-charset-to-coding-system charset))) @@ -91,12 +155,19 @@ find-file-hooks, etc. (encode-coding-string string cs) string))) -(defsubst decode-mime-charset-string (string charset) +;; (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) "Decode the STRING as MIME CHARSET." - (let ((cs (mime-charset-to-coding-system charset))) - (if cs - (decode-coding-string string cs) - string))) + (with-temp-buffer + (insert string) + (decode-mime-charset-region (point-min)(point-max) charset) + (buffer-string) + )) (defvar charsets-mime-charset-alist -- 1.7.10.4