X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=sidebyside;f=lisp%2Fmm-util.el;h=750c3ec72454b78165530ce75f0241c4ae46574f;hb=a3dceb5435f0e48f5b39a10508e3d7d14aa9e8c2;hp=59dae6d87d424acf3ac3cc6010e4cdd11c146e67;hpb=5f498109ec429459516634359a50c2457e5678bc;p=elisp%2Fgnus.git- diff --git a/lisp/mm-util.el b/lisp/mm-util.el index 59dae6d..750c3ec 100644 --- a/lisp/mm-util.el +++ b/lisp/mm-util.el @@ -1,5 +1,5 @@ ;;; mm-util.el --- Utility functions for Mule and low level things -;; Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko @@ -43,7 +43,6 @@ (coding-system-list . ignore) (decode-coding-region . ignore) (char-int . identity) - (device-type . ignore) (coding-system-equal . equal) (annotationp . ignore) (set-buffer-file-coding-system . ignore) @@ -124,7 +123,7 @@ '((iso-8859-15 . iso-8859-1))) ;; Windows-1252 is actually a superset of Latin-1. See also ;; `gnus-article-dumbquotes-map'. - ,@(unless (mm-coding-system-p 'windows-1252) + ,@(unless (mm-coding-system-p 'windows-1252) (if (mm-coding-system-p 'cp1252) '((windows-1252 . cp1252)) '((windows-1252 . iso-8859-1)))) @@ -248,7 +247,7 @@ Valid elements include: `iso-2022-jp-2' convert ISO-2022-jp to ISO-2022-jp-2 if ISO-2022-jp-2 exists." ) -(defvar mm-iso-8859-15-compatible +(defvar mm-iso-8859-15-compatible '((iso-8859-1 "\xA4\xA6\xA8\xB4\xB8\xBC\xBD\xBE") (iso-8859-9 "\xA4\xA6\xA8\xB4\xB8\xBC\xBD\xBE\xD0\xDD\xDE\xF0\xFD\xFE")) "ISO-8859-15 exchangeable coding systems and inconvertible characters.") @@ -256,22 +255,22 @@ Valid elements include: (defvar mm-iso-8859-x-to-15-table (and (fboundp 'coding-system-p) (mm-coding-system-p 'iso-8859-15) - (mapcar + (mapcar (lambda (cs) (if (mm-coding-system-p (car cs)) - (let ((c (string-to-char + (let ((c (string-to-char (decode-coding-string "\341" (car cs))))) (cons (char-charset c) (cons - (- (string-to-char + (- (string-to-char (decode-coding-string "\341" 'iso-8859-15)) c) - (string-to-list (decode-coding-string (car (cdr cs)) + (string-to-list (decode-coding-string (car (cdr cs)) (car cs)))))) '(gnus-charset 0))) mm-iso-8859-15-compatible)) "A table of the difference character between ISO-8859-X and ISO-8859-15.") -(defvar mm-coding-system-priorities nil +(defcustom mm-coding-system-priorities nil "Preferred coding systems for encoding outgoing mails. More than one suitable coding systems may be found for some texts. By @@ -281,8 +280,17 @@ it overrides the default priority. For example, Japanese users may prefer iso-2022-jp to japanese-shift-jis: \(setq mm-coding-system-priorities - '(iso-2022-jp iso-2022-jp-2 japanese-shift-jis utf-8)) -") + '(iso-2022-jp iso-2022-jp-2 japanese-shift-jis iso-latin-1 utf-8)) +" + :type '(repeat (symbol :tag "Coding system")) + :group 'mime) + +(defvar mm-use-find-coding-systems-region + (fboundp 'find-coding-systems-region) + "Use `find-coding-systems-region' to find proper coding systems. + +Setting it to nil is useful on Emacsen supporting Unicode if sending +mail with multiple parts is preferred to sending a Unicode one.") ;;; Internal variables: @@ -334,10 +342,8 @@ used as the line break code type of the coding system." ) charset) ;; Translate invalid charsets. - ((mm-coding-system-p (setq charset - (cdr (assq charset - mm-charset-synonym-alist)))) - charset) + ((let ((cs (cdr (assq charset mm-charset-synonym-alist)))) + (and cs (mm-coding-system-p cs) cs))) ;; Last resort: search the coding system list for entries which ;; have the right mime-charset in case the canonical name isn't ;; defined (though it should be). @@ -359,7 +365,7 @@ used as the line break code type of the coding system." default-enable-multibyte-characters (fboundp 'set-buffer-multibyte)) "Emacs mule.") - + (defvar mm-mule4-p (and mm-emacs-mule (fboundp 'charsetp) (not (charsetp 'eight-bit-control))) @@ -386,7 +392,7 @@ This is a no-op in XEmacs." Only used in Emacs Mule 4." (set-buffer-multibyte t)) (defalias 'mm-enable-multibyte-mule4 'ignore)) - + (if mm-mule4-p (defun mm-disable-multibyte-mule4 () "Disable multibyte in the current buffer. @@ -399,6 +405,26 @@ Only used in Emacs Mule 4." (or (get-charset-property charset 'preferred-coding-system) (get-charset-property charset 'prefered-coding-system))) +(defsubst mm-guess-charset () + "Guess Mule charset from the language environment." + (or + mail-parse-mule-charset ;; cached mule-charset + (progn + (setq mail-parse-mule-charset + (and (boundp 'current-language-environment) + (car (last + (assq 'charset + (assoc current-language-environment + language-info-alist)))))) + (if (or (not mail-parse-mule-charset) + (eq mail-parse-mule-charset 'ascii)) + (setq mail-parse-mule-charset + (or (car (last (assq mail-parse-charset + mm-mime-mule-charset-alist))) + ;; default + 'latin-iso8859-1))) + mail-parse-mule-charset))) + (defun mm-charset-after (&optional pos) "Return charset of a character in current buffer at position POS. If POS is nil, it defauls to the current point. @@ -415,23 +441,7 @@ If the charset is `composition', return the actual one." (if (and charset (not (memq charset '(ascii eight-bit-control eight-bit-graphic)))) charset - (or - mail-parse-mule-charset ;; cached mule-charset - (progn - (setq mail-parse-mule-charset - (and (boundp 'current-language-environment) - (car (last - (assq 'charset - (assoc current-language-environment - language-info-alist)))))) - (if (or (not mail-parse-mule-charset) - (eq mail-parse-mule-charset 'ascii)) - (setq mail-parse-mule-charset - (or (car (last (assq mail-parse-charset - mm-mime-mule-charset-alist))) - ;; Fixme: don't fix that! - 'latin-iso8859-1))) - mail-parse-mule-charset))))))) + (mm-guess-charset)))))) (defun mm-mime-charset (charset) "Return the MIME charset corresponding to the given Mule CHARSET." @@ -459,14 +469,13 @@ If the charset is `composition', return the actual one." (setq result (cons head result))) (nreverse result))) -;; It's not clear whether this is supposed to mean the global or local -;; setting. I think it's used inconsistently. -- fx -(defsubst mm-multibyte-p () - "Say whether multibyte is enabled." - (if (and (not (featurep 'xemacs)) - (boundp 'enable-multibyte-characters)) - enable-multibyte-characters - (featurep 'mule))) +(if (and (not (featurep 'xemacs)) + (boundp 'enable-multibyte-characters)) + (defalias 'mm-multibyte-p + (lambda () + "Say whether multibyte is enabled in the current buffer." + enable-multibyte-characters)) + (defalias 'mm-multibyte-p (lambda () (featurep 'mule)))) (defun mm-iso-8859-x-to-15-region (&optional b e) (if (fboundp 'char-charset) @@ -476,15 +485,15 @@ If the charset is `composition', return the actual one." (goto-char (point-min)) (skip-chars-forward "\0-\177") (while (not (eobp)) - (cond - ((not (setq item (assq (char-charset (setq c (char-after))) + (cond + ((not (setq item (assq (char-charset (setq c (char-after))) mm-iso-8859-x-to-15-table))) (forward-char)) ((memq c (cdr (cdr item))) (setq inconvertible t) (forward-char)) (t - (insert-before-markers (prog1 (+ c (car (cdr item))) + (insert-before-markers (prog1 (+ c (car (cdr item))) (delete-char 1)))) (skip-chars-forward "\0-\177")))) (not inconvertible)))) @@ -500,12 +509,12 @@ charset, and a longer list means no appropriate charset." (let (charsets) ;; The return possibilities of this function are a mess... (or (and (mm-multibyte-p) - (fboundp 'find-coding-systems-region) + mm-use-find-coding-systems-region ;; Find the mime-charset of the most preferred coding ;; system that has one. (let ((systems (find-coding-systems-region b e))) (when mm-coding-system-priorities - (setq systems + (setq systems (sort systems 'mm-sort-coding-systems-predicate))) ;; Fixme: The `mime-charset' (`x-ctext') of `compound-text' ;; is not in the IANA list. @@ -519,7 +528,7 @@ charset, and a longer list means no appropriate charset." charsets)) ;; Otherwise we're not multibyte, XEmacs or a single coding ;; system won't cover it. - (setq charsets + (setq charsets (mm-delete-duplicates (mapcar 'mm-mime-charset (delq 'ascii @@ -548,8 +557,8 @@ Also bind `default-enable-multibyte-characters' to nil. Equivalent to `progn' in XEmacs" (let ((multibyte (make-symbol "multibyte")) (buffer (make-symbol "buffer"))) - `(if mm-emacs-mule - (let ((,multibyte enable-multibyte-characters) + `(if mm-emacs-mule + (let ((,multibyte enable-multibyte-characters) (,buffer (current-buffer))) (unwind-protect (let (default-enable-multibyte-characters) @@ -568,7 +577,7 @@ Mule4 only." (let ((multibyte (make-symbol "multibyte")) (buffer (make-symbol "buffer"))) `(if mm-mule4-p - (let ((,multibyte enable-multibyte-characters) + (let ((,multibyte enable-multibyte-characters) (,buffer (current-buffer))) (unwind-protect (let (default-enable-multibyte-characters) @@ -725,6 +734,70 @@ If INHIBIT is non-nil, inhibit mm-inhibit-file-name-handlers." (push dir result)) (push path result)))) +(if (fboundp 'detect-coding-region) + (defun mm-detect-coding-region (start end) + "Like 'detect-coding-region' except returning the best one." + (let ((coding-systems + (detect-coding-region (point) (point-max)))) + (or (car-safe coding-systems) + coding-systems))) + (defun mm-detect-coding-region (start end) + (let ((point (point))) + (goto-char start) + (skip-chars-forward "\0-\177" end) + (prog1 + (if (eq (point) end) 'ascii (mm-guess-charset)) + (goto-char point))))) + +(if (fboundp 'coding-system-get) + (defun mm-detect-mime-charset-region (start end) + "Detect MIME charset of the text in the region between START and END." + (let ((cs (mm-detect-coding-region start end))) + (coding-system-get cs 'mime-charset))) + (defun mm-detect-mime-charset-region (start end) + "Detect MIME charset of the text in the region between START and END." + (let ((cs (mm-detect-coding-region start end))) + cs))) + +(defun mm-guess-mime-charset () + "Guess the default MIME charset from the language environment." + (let ((language-info + (and (boundp 'current-language-environment) + (assoc current-language-environment + language-info-alist))) + item) + (cond + ((null language-info) + 'iso-8859-1) + ((setq item + (cadr + (or (assq 'coding-priority language-info) + (assq 'coding-system language-info)))) + (if (fboundp 'coding-system-get) + (or (coding-system-get item 'mime-charset) + item) + item)) + ((setq item (car (last (assq 'charset language-info)))) + (if (eq item 'ascii) + 'iso-8859-1 + (mm-mime-charset item))) + (t + 'iso-8859-1)))) + +;; It is not a MIME function, but some MIME functions use it. +(defalias 'mm-make-temp-file + (if (fboundp 'make-temp-file) + 'make-temp-file + (lambda (prefix &optional dir-flag) + (let ((file (expand-file-name + (make-temp-name prefix) + (if (fboundp 'temp-directory) + (temp-directory) + temporary-file-directory)))) + (if dir-flag + (make-directory file)) + file)))) + (provide 'mm-util) ;;; mm-util.el ends here