;;; 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, 2003
+;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
(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)
(setq idx (1+ idx)))
string)))
(string-as-unibyte . identity)
+ (string-make-unibyte . identity)
(string-as-multibyte . identity)
(multibyte-string-p . ignore))))
'((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))))
"Coding system of auto save file.")
(defvar mm-universal-coding-system mm-auto-save-coding-system
- "The universal Coding system.")
+ "The universal coding system.")
;; Fixme: some of the cars here aren't valid MIME charsets. That
;; should only matter with XEmacs, though.
(sort-coding-systems (coding-system-list 'base-only))))))
(defvar mm-hack-charsets '(iso-8859-15 iso-2022-jp-2)
- "A list of special charsets when encoding.
-The each element could be one of the following:
+ "A list of special charsets.
+Valid elements include:
`iso-8859-15' convert ISO-8859-1, -9 to ISO-8859-15 if ISO-8859-15 exists.
`iso-2022-jp-2' convert ISO-2022-jp to ISO-2022-jp-2 if ISO-2022-jp-2 exists."
)
-;; FIXME: what the value should be?
-(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"))
- "Coding systems (inconvertible characters) to ISO-8859-15.")
+ "ISO-8859-15 exchangeable coding systems and inconvertible characters.")
(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.")
+(defcustom mm-coding-system-priorities
+ (if (boundp 'current-language-environment)
+ (let ((lang (symbol-value 'current-language-environment)))
+ (cond ((string= lang "Japanese")
+ ;; Japanese users may prefer iso-2022-jp to shift-jis.
+ '(iso-2022-jp iso-2022-jp-2 japanese-shift-jis
+ iso-latin-1 utf-8)))))
+ "Preferred coding systems for encoding outgoing mails.
+
+More than one suitable coding systems may be found for some texts. By
+default, a coding system with the highest priority is used to encode
+outgoing mails (see `sort-coding-systems'). If this variable is set,
+it overrides the default priority."
+ :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:
;;; Functions:
(defun mm-mule-charset-to-mime-charset (charset)
"Return the MIME charset corresponding to the given Mule CHARSET."
- (if (fboundp 'find-coding-systems-for-charsets)
+ (if (and (fboundp 'find-coding-systems-for-charsets)
+ (fboundp 'sort-coding-systems))
(let (mime)
- (dolist (cs (find-coding-systems-for-charsets (list charset)))
+ (dolist (cs (sort-coding-systems
+ (copy-sequence
+ (find-coding-systems-for-charsets (list charset)))))
(unless mime
(when cs
(setq mime (coding-system-get cs 'mime-charset)))))
)
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).
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)))
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.
(defun mm-preferred-coding-system (charset)
;; A typo in some Emacs versions.
- (or (get-charset-property charset 'prefered-coding-system)
- (get-charset-property charset 'preferred-coding-system)))
+ (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 (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."
(mm-mule-charset-to-mime-charset charset)))
(defun mm-delete-duplicates (list)
- "Simple substitute for CL `delete-duplicates', testing with `equal'."
+ "Simple substitute for CL `delete-duplicates', testing with `equal'."
(let (result head)
(while list
(setq head (car list))
(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)
(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 (prog1 (+ c (car (cdr item))) (delete-char 1))))
- (skip-chars-forward "\0-\177"))))
+ (insert-before-markers (prog1 (+ c (car (cdr item)))
+ (delete-char 1)))))
+ (skip-chars-forward "\0-\177")))
(not inconvertible))))
+(defun mm-sort-coding-systems-predicate (a b)
+ (> (length (memq a mm-coding-system-priorities))
+ (length (memq b mm-coding-system-priorities))))
+
(defun mm-find-mime-charset-region (b e &optional hack-charsets)
"Return the MIME charsets needed to encode the region between B and E.
-Nil means ASCII, a single-element list represents an appropriate MIME
+nil means ASCII, a single-element list represents an appropriate MIME
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
+ (sort systems 'mm-sort-coding-systems-predicate)))
;; Fixme: The `mime-charset' (`x-ctext') of `compound-text'
;; is not in the IANA list.
(setq systems (delq 'compound-text systems))
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
(mm-find-charset-region b e))))))
- (if (and (memq 'iso-8859-15 charsets)
+ (if (and (> (length charsets) 1)
+ (memq 'iso-8859-15 charsets)
(memq 'iso-8859-15 hack-charsets)
(save-excursion (mm-iso-8859-x-to-15-region b e)))
(mapcar (lambda (x) (setq charsets (delq (car x) charsets)))
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)
(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)
saying what text to write.
Optional fourth argument specifies the coding system to use when
encoding the file.
-If INHIBIT is non-nil, inhibit mm-inhibit-file-name-handlers."
+If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'."
(let ((coding-system-for-write
(or codesys mm-text-coding-system-for-write
mm-text-coding-system))
coding-system inhibit)
"Like `write-region'.
-If INHIBIT is non-nil, inhibit mm-inhibit-file-name-handlers."
+If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'."
(let ((coding-system-for-write
(or coding-system mm-text-coding-system-for-write
mm-text-coding-system))
(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