X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fmm-util.el;h=dfad2a2ad7a502c14f83cfa56d9b0dcf777cb6f9;hb=30d9f23f0291edcefeca1958befadb992d2982b5;hp=aaae62d5df86f34efc91b25bab8f7f4b2d255d74;hpb=82300762c3419b73fc2e994b14e3d520fe88b0a9;p=elisp%2Fgnus.git- diff --git a/lisp/mm-util.el b/lisp/mm-util.el index aaae62d..dfad2a2 100644 --- a/lisp/mm-util.el +++ b/lisp/mm-util.el @@ -26,38 +26,26 @@ (defvar mm-running-xemacs (string-match "XEmacs" emacs-version)) -(defvar mm-running-ntemacs - (and (not mm-running-xemacs) +(defvar mm-running-ntemacs + (and (not mm-running-xemacs) (string-match "nt" system-configuration))) -(defvar mm-binary-coding-system +(defvar mm-binary-coding-system (if mm-running-xemacs 'binary 'no-conversion) - "100% binary coding system.") + "100% binary coding system.") -(defvar mm-text-coding-system - (cond +(defvar mm-text-coding-system + (cond ((not (fboundp 'coding-system-p)) nil) (mm-running-xemacs ;; XEmacs - (and (coding-system-p 'no-conversion) 'no-conversion)) + 'no-conversion) (mm-running-ntemacs ;; NTEmacs (and (coding-system-p 'raw-text-dos) 'raw-text-dos)) ((coding-system-p 'raw-text) 'raw-text) ;; Emacs (t nil)) "100% text coding system, for removing ^M.") -(defvar mm-default-coding-system nil - "The default coding system to use.") - -(defvar mm-known-charsets '(iso-8859-1) - "List of known charsets. -Use this under non-Mule Emacsen to specify which charsets your Emacs -can display. Also see `mm-default-charset'.") - -(defvar mm-default-charset 'iso-8859-1 - "Default charset assumed to be used when viewing non-ASCII characters. -This variable is used only in non-Mule Emacsen.") - (defvar mm-mime-mule-charset-alist '((us-ascii ascii) (iso-8859-1 latin-iso8859-1) @@ -70,16 +58,21 @@ This variable is used only in non-Mule Emacsen.") (iso-8859-7 greek-iso8859-7) (iso-8859-8 hebrew-iso8859-8) (iso-8859-9 latin-iso8859-9) + (viscii vietnamese-viscii-lower) (iso-2022-jp-2 japanese-jisx0208) (iso-2022-jp latin-jisx0201 japanese-jisx0208-1978) (euc-kr korean-ksc5601) (cn-gb-2312 chinese-gb2312) (cn-big5 chinese-big5-1 chinese-big5-2) + (tibetan tibetan) + (thai-tis620 thai-tis620) + (iso-2022-7bit ethiopic arabic-1-column arabic-2-column) (iso-2022-jp-2 latin-iso8859-1 greek-iso8859-7 latin-jisx0201 japanese-jisx0208-1978 chinese-gb2312 japanese-jisx0208 - korean-ksc5601 japanese-jisx0212) + korean-ksc5601 japanese-jisx0212 + katakana-jisx0201) (iso-2022-int-1 latin-iso8859-1 greek-iso8859-7 latin-jisx0201 japanese-jisx0208-1978 chinese-gb2312 japanese-jisx0208 @@ -130,23 +123,15 @@ This variable is used only in non-Mule Emacsen.") (or mm-coding-system-list (setq mm-coding-system-list (mm-coding-system-list)))) -(defvar mm-charset-coding-system-alist - (let ((rest - '((gb2312 . cn-gb-2312) - (iso-2022-jp-2 . iso-2022-7bit-ss2) - (x-ctext . ctext))) - (systems (mm-get-coding-system-list)) - dest) - (while rest - (let ((pair (car rest))) - (unless (memq (car pair) systems) - (setq dest (cons pair dest)))) - (setq rest (cdr rest))) - dest) - "Charset/coding system alist.") +(defvar mm-charset-synonym-alist + '((big5 . cn-big5) + (gb2312 . cn-gb-2312) + (x-ctext . ctext)) + "A mapping from invalid charset names to the real charset names.") -;;;Internal variable -(defvar mm-charset-iso-8859-1-forced nil) +;;; Internal variables: + +;;; Functions: (defun mm-mule-charset-to-mime-charset (charset) "Return the MIME charset corresponding to MULE CHARSET." @@ -166,19 +151,14 @@ If optional argument LBT (`unix', `dos' or `mac') is specified, it is used as the line break code type of the coding system." (when (stringp charset) (setq charset (intern (downcase charset)))) - (if (and mm-charset-iso-8859-1-forced - (eq charset 'iso-8859-1)) - (setq charset mm-charset-iso-8859-1-forced)) (setq charset - (or (cdr (assq charset mm-charset-coding-system-alist)) + (or (cdr (assq charset mm-charset-synonym-alist)) charset)) (when lbt (setq charset (intern (format "%s-%s" charset lbt)))) (cond ;; Running in a non-MULE environment. - ((and (null (mm-get-coding-system-list)) - (or (eq charset mm-default-charset) - (memq charset mm-known-charsets))) + ((null (mm-get-coding-system-list)) charset) ;; ascii ((eq charset 'us-ascii) @@ -213,22 +193,30 @@ used as the line break code type of the coding system." (when (fboundp 'set-buffer-multibyte) (set-buffer-multibyte nil))) -(defun mm-mime-charset (charset b e) +(defun mm-mime-charset (charset) + "Return the MIME charset corresponding to the MULE CHARSET." (if (fboundp 'coding-system-get) + ;; This exists in Emacs 20. (or - (and - mm-default-coding-system - (let ((safe (coding-system-get mm-default-coding-system - 'safe-charsets))) - (or (eq safe t) (memq charset safe))) - (coding-system-get mm-default-coding-system 'mime-charset)) - (coding-system-get - (get-charset-property charset 'prefered-coding-system) - 'mime-charset) - (car (memq charset (find-coding-systems-region - (point-min) (point-max))))) + (and (get-charset-property charset 'prefered-coding-system) + (coding-system-get + (get-charset-property charset 'prefered-coding-system) + 'mime-charset)) + (and (eq charset 'ascii) + 'us-ascii) + (get-charset-property charset 'prefered-coding-system) + (mm-mule-charset-to-mime-charset charset)) + ;; This is for XEmacs. (mm-mule-charset-to-mime-charset charset))) +(defun mm-find-mime-charset-region (b e) + "Return the MIME charsets needed to encode the region between B and E." + (let ((charsets + (mapcar 'mm-mime-charset + (delq 'ascii + (mm-find-charset-region b e))))) + (delete-duplicates charsets))) + (defsubst mm-multibyte-p () "Say whether multibyte is enabled." (and (boundp 'enable-multibyte-characters) @@ -264,8 +252,8 @@ See also `with-temp-file' and `with-output-to-string'." "Return a list of charsets in the region." (cond ((and (boundp 'enable-multibyte-characters) - enable-multibyte-characters - (fboundp 'find-charset-region)) + enable-multibyte-characters + (fboundp 'find-charset-region)) (find-charset-region b e)) ((not (boundp 'current-language-environment)) (save-excursion @@ -275,8 +263,7 @@ See also `with-temp-file' and `with-output-to-string'." (skip-chars-forward "\0-\177") (if (eobp) '(ascii) - ;;;!!!bogus - (list 'ascii 'latin-iso8859-1))))) + (delq nil (list 'ascii mail-parse-charset)))))) (t ;; We are in a unibyte buffer, so we futz around a bit. (save-excursion @@ -290,6 +277,15 @@ See also `with-temp-file' and `with-output-to-string'." '(ascii) (list 'ascii (car (last (assq 'charset entry))))))))))) +(defun mm-read-charset (prompt) + "Return a charset." + (intern + (completing-read + prompt + (mapcar (lambda (e) (list (symbol-name (car e)))) + mm-mime-mule-charset-alist) + nil t))) + (provide 'mm-util) ;;; mm-util.el ends here