From e168e5c74a9ca5910a7e959a82a57a603336cdeb Mon Sep 17 00:00:00 2001 From: tomo Date: Tue, 31 Dec 2002 08:17:47 +0000 Subject: [PATCH] (mcs-region-repertoire-p): New function for UTF-2000 implementations. (mcs-string-repertoire-p): Likewise. (detect-mime-charset-region): New implementation for UTF-2000 implementations. (detect-mime-charset-string): New function for UTF-2000 implementations. --- mcs-20.el | 68 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 68 insertions(+) diff --git a/mcs-20.el b/mcs-20.el index ca9f394..7b78585 100644 --- a/mcs-20.el +++ b/mcs-20.el @@ -144,10 +144,78 @@ It must be symbol." :group 'i18n :type 'mime-charset) +(cond ((featurep 'utf-2000) +;; for CHISE Architecture +(defun mcs-region-repertoire-p (start end charsets &optional buffer) + (save-excursion + (if buffer + (set-buffer buffer)) + (save-restriction + (narrow-to-region start end) + (goto-char (point-min)) + (catch 'tag + (let (ch) + (while (not (eobp)) + (setq ch (char-after (point))) + (unless (some (lambda (ccs) + (encode-char ch ccs)) + charsets) + (throw 'tag nil)) + (forward-char))) + t)))) + +(defun mcs-string-repertoire-p (string charsets &optional start end) + (let ((i (if start + (if (< start 0) + (error 'args-out-of-range string start end) + start) + 0)) + ch) + (if end + (if (> end (length string)) + (error 'args-out-of-range string start end)) + (setq end (length string))) + (catch 'tag + (while (< i end) + (setq ch (aref string i)) + (unless (some (lambda (ccs) + (encode-char ch ccs)) + charsets) + (throw 'tag nil)) + (setq i (1+ i))) + t))) + +(defun detect-mime-charset-region (start end) + "Return MIME charset for region between START and END." + (let ((rest charsets-mime-charset-alist) + cell) + (catch 'tag + (while rest + (setq cell (car rest)) + (if (mcs-region-repertoire-p start end (car cell)) + (throw 'tag (cdr cell))) + (setq rest (cdr rest))) + default-mime-charset-for-write))) + +(defun detect-mime-charset-string (string) + "Return MIME charset for STRING." + (let ((rest charsets-mime-charset-alist) + cell) + (catch 'tag + (while rest + (setq cell (car rest)) + (if (mcs-string-repertoire-p string (car cell)) + (throw 'tag (cdr cell))) + (setq rest (cdr rest))) + default-mime-charset-for-write))) +) +(t +;; for legacy Mule (defun detect-mime-charset-region (start end) "Return MIME charset for region between START and END." (find-mime-charset-by-charsets (find-charset-region start end) 'region start end)) +)) (defun write-region-as-mime-charset (charset start end filename &optional append visit lockname) -- 1.7.10.4