;;; mcs-20.el --- MIME charset implementation for Emacs 20 and XEmacs/mule
-;; Copyright (C) 1997,1998,1999 Free Software Foundation, Inc.
+;; Copyright (C) 1997,1998,1999,2000 Free Software Foundation, Inc.
-;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Author: MORIOKA Tomohiko <tomo@m17n.org>
;; Keywords: emulation, compatibility, Mule
;; This file is part of APEL (A Portable Emacs Library).
;; 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.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;; Code:
-(require 'poem)
(require 'custom)
(eval-when-compile (require 'wid-edit))
+(if (featurep 'xemacs)
+ (require 'mcs-xm)
+ (require 'mcs-e20))
+
;;; @ MIME charset
;;;
(gb2312 . cn-gb-2312)
(cn-gb . cn-gb-2312)
(iso-2022-jp-2 . iso-2022-7bit-ss2)
+ (iso-2022-jp-3 . iso-2022-7bit-ss2)
(tis-620 . tis620)
- (windows-874 . tis620)
+ (windows-874 . tis-620)
+ (cp874 . tis-620)
(x-ctext . ctext)
(unknown . undecided)
(x-unknown . undecided)
:group 'i18n
:type '(choice function (const nil)))
-(defsubst mime-charset-to-coding-system (charset &optional lbt)
+(defun 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')
charset lbt cs)
))))
+(defalias 'mime-charset-p 'mime-charset-to-coding-system)
+
(defvar widget-mime-charset-prompt-value-history nil
"History of input to `widget-mime-charset-prompt-value'.")
(widget-apply widget :notify widget event)
(widget-setup)))
-(defcustom default-mime-charset 'x-ctext
+(defcustom default-mime-charset 'x-unknown
"Default value of MIME-charset.
It is used when MIME-charset is not specified.
It must be symbol."
:group 'i18n
:type 'mime-charset)
-(defcustom default-mime-charset-for-write
- (if (find-coding-system 'utf-8)
- 'utf-8
- default-mime-charset)
- "Default value of MIME-charset for encoding.
-It may be used when suitable MIME-charset is not found.
-It must be symbol."
- :group 'i18n
- :type 'mime-charset)
-
-(defcustom default-mime-charset-detect-method-for-write
- nil
- "Function called when suitable MIME-charset is not found to encode.
-It must be nil or function.
-If it is nil, variable `default-mime-charset-for-write' is used.
-If it is a function, interface must be (TYPE CHARSETS &rest ARGS).
-CHARSETS is list of charset.
-If TYPE is 'region, ARGS has START and END."
- :group 'i18n
- :type '(choice function (const nil)))
+(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 ((charsets (find-charset-region start end)))
- (or (charsets-to-mime-charset charsets)
- (if default-mime-charset-detect-method-for-write
- (funcall default-mime-charset-detect-method-for-write
- 'region charsets start end)
- default-mime-charset-for-write)
- )))
+ (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)
;;; @ end
;;;
-(provide 'mcs-20)
+(require 'product)
+(product-provide (provide 'mcs-20) (require 'apel-ver))
;;; mcs-20.el ends here
projects / elisp / apel.git / blobdiff