;;; 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))))
`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.")
(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
+ (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. For example, Japanese users may
-prefer iso-2022-jp to japanese-shift-jis:
+it overrides the default priority."
+ :type '(repeat (symbol :tag "Coding system"))
+ :group 'mime)
-\(setq mm-coding-system-priorities
- '(iso-2022-jp iso-2022-jp-2 japanese-shift-jis utf-8))
-")
+(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:
)
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.
(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.
(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."
(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-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))))
(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.
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
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)
(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
projects / elisp / gnus.git- / blobdiff