X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mcharset.el;h=156c34e7763e3b17a9466a4cc57ed25baed57e9b;hb=f601b82c55f8002e6c1044193d10041f62792f2a;hp=5ce21087a925cfaafd76366fd315cea07d6a3b02;hpb=0df64d3b6ef5ae5212fd59ee13dd5f044b378ba6;p=elisp%2Fapel.git diff --git a/mcharset.el b/mcharset.el index 5ce2108..156c34e 100644 --- a/mcharset.el +++ b/mcharset.el @@ -1,8 +1,8 @@ ;;; mcharset.el --- MIME charset API -;; Copyright (C) 1997,1998 Free Software Foundation, Inc. +;; Copyright (C) 1997,1998,1999 Free Software Foundation, Inc. -;; Author: MORIOKA Tomohiko +;; Author: MORIOKA Tomohiko ;; Keywords: emulation, compatibility, Mule ;; This file is part of APEL (A Portable Emacs Library). @@ -25,6 +25,7 @@ ;;; Code: (require 'poe) +(require 'pcustom) (cond ((featurep 'mule) (cond ((featurep 'xemacs) @@ -46,34 +47,73 @@ (require 'mcs-ltn1) )) +(defcustom default-mime-charset-for-write + (if (and (fboundp 'find-coding-system) + (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))) (defun charsets-to-mime-charset (charsets) "Return MIME charset from list of charset CHARSETS. -This function refers variable `charsets-mime-charset-alist' -and `default-mime-charset'." +Return nil if suitable mime-charset is not found." (if charsets - (or (catch 'tag - (let ((rest charsets-mime-charset-alist) - cell) - (while (setq cell (car rest)) - (if (catch 'not-subset - (let ((set1 charsets) - (set2 (car cell)) - obj) - (while set1 - (setq obj (car set1)) - (or (memq obj set2) - (throw 'not-subset nil)) - (setq set1 (cdr set1))) - t)) - (throw 'tag (cdr cell))) - (setq rest (cdr rest))))) - default-mime-charset))) + (catch 'tag + (let ((rest charsets-mime-charset-alist) + cell) + (while (setq cell (car rest)) + (if (catch 'not-subset + (let ((set1 charsets) + (set2 (car cell)) + obj) + (while set1 + (setq obj (car set1)) + (or (memq obj set2) + (throw 'not-subset nil)) + (setq set1 (cdr set1))) + t)) + (throw 'tag (cdr cell))) + (setq rest (cdr rest))) + )))) + +(defun find-mime-charset-by-charsets (charsets &optional mode &rest args) + "Like `charsets-to-mime-charset', but it does not return nil. + +When suitable mime-charset is not found and variable +`default-mime-charset-detect-method-for-write' is not nil, +`find-mime-charset-by-charsets' calls the variable as function and +return the return value of the function. +Interface of the function is (MODE CHARSETS &rest ARGS). + +When suitable mime-charset is not found and variable +`default-mime-charset-detect-method-for-write' is nil, +variable `default-mime-charset-for-write' is returned." + (or (charsets-to-mime-charset charsets) + (if default-mime-charset-detect-method-for-write + (apply default-mime-charset-detect-method-for-write + mode charsets args) + default-mime-charset-for-write))) ;;; @ end ;;; -(provide 'mcharset) +(require 'product) +(product-provide (provide 'mcharset) (require 'apel-ver)) ;;; mcharset.el ends here