;;; 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))))
(defvar mm-charset-synonym-alist
`(
;; Perfectly fine? A valid MIME name, anyhow.
- ,(unless (mm-coding-system-p 'big5)
- '(big5 . cn-big5))
+ ,@(unless (mm-coding-system-p 'big5)
+ '((big5 . cn-big5)))
;; Not in XEmacs, but it's not a proper MIME charset anyhow.
- ,(unless (mm-coding-system-p 'x-ctext)
- '(x-ctext . ctext))
+ ,@(unless (mm-coding-system-p 'x-ctext)
+ '((x-ctext . ctext)))
;; Apparently not defined in Emacs 20, but is a valid MIME name.
- ,(unless (mm-coding-system-p 'gb2312)
- '(gb2312 . cn-gb-2312))
+ ,@(unless (mm-coding-system-p 'gb2312)
+ '((gb2312 . cn-gb-2312)))
+ ;; ISO-8859-15 is very similar to ISO-8859-1.
+ ,@(unless (mm-coding-system-p 'iso-8859-15) ; Emacs 21 defines it.
+ '((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)
- ; should be defined eventually
- ;; '(windows-1252 . iso-8859-1))
- ;; ISO-8859-15 is very similar to ISO-8859-1.
- ;;,(unless (mm-coding-system-p 'iso-8859-15) ; Emacs 21 defines it.
- ;; '(iso-8859-15 . iso-8859-1))
+ ,@(unless (mm-coding-system-p 'windows-1252)
+ (if (mm-coding-system-p 'cp1252)
+ '((windows-1252 . cp1252))
+ '((windows-1252 . iso-8859-1))))
;; Windows-1250 is a variant of Latin-2 heavily used by Microsoft
;; Outlook users in Czech republic. Use this to allow reading of their
;; e-mails. cp1250 should be defined by M-x codepage-setup.
- ;;,(unless (mm-coding-system-p 'windows-1250)
- ; should be defined eventually
- ;; '(windows-1250 . cp1250))
+ ,@(if (and (not (mm-coding-system-p 'windows-1250))
+ (mm-coding-system-p 'cp1250))
+ '((windows-1250 . cp1250)))
)
"A mapping from invalid charset names to the real charset names.")
"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.
(coding-system-get cs 'safe-charsets))))))
(sort-coding-systems (coding-system-list 'base-only))))))
+(defvar mm-hack-charsets '(iso-8859-15 iso-2022-jp-2)
+ "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."
+)
+
+(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
+ (lambda (cs)
+ (if (mm-coding-system-p (car cs))
+ (let ((c (string-to-char
+ (decode-coding-string "\341" (car cs)))))
+ (cons (char-charset c)
+ (cons
+ (- (string-to-char
+ (decode-coding-string "\341" 'iso-8859-15)) c)
+ (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:
(when lbt
(setq charset (intern (format "%s-%s" charset lbt))))
(cond
+ ((null charset)
+ charset)
;; Running in a non-MULE environment.
((null (mm-get-coding-system-list))
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."
(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)))
-
-(defun mm-find-mime-charset-region (b e)
+(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)
+ (let (charset item c inconvertible)
+ (save-restriction
+ (if e (narrow-to-region b e))
+ (goto-char (point-min))
+ (skip-chars-forward "\0-\177")
+ (while (not (eobp))
+ (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)))
+ (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."
- ;; The return possibilities of this function are a mess...
- (or (and
- (mm-multibyte-p)
- (fboundp '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))
- result)
- ;; Fixme: The `mime-charset' (`x-ctext') of `compound-text'
- ;; is not in the IANA list.
- (setq systems (delq 'compound-text systems))
- (unless (equal systems '(undecided))
- (while systems
- (let ((cs (coding-system-get (pop systems) 'mime-charset)))
- (if cs
- (setq systems nil
- result (list cs))))))
- result))
- ;; Otherwise we're not multibyte, XEmacs or a single coding
- ;; system won't cover it.
- (let ((charsets
- (mm-delete-duplicates
- (mapcar 'mm-mime-charset
- (delq 'ascii
- (mm-find-charset-region b e))))))
- (if (memq 'iso-2022-jp-2 charsets)
- (delq 'iso-2022-jp charsets)
- charsets))))
+ (let (charsets)
+ ;; The return possibilities of this function are a mess...
+ (or (and (mm-multibyte-p)
+ 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))
+ (unless (equal systems '(undecided))
+ (while systems
+ (let ((cs (coding-system-get (pop systems) 'mime-charset)))
+ (if cs
+ (setq systems nil
+ charsets (list cs))))))
+ charsets))
+ ;; Otherwise we're not multibyte, XEmacs or a single coding
+ ;; system won't cover it.
+ (setq charsets
+ (mm-delete-duplicates
+ (mapcar 'mm-mime-charset
+ (delq 'ascii
+ (mm-find-charset-region b e))))))
+ (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)))
+ mm-iso-8859-15-compatible))
+ (if (and (memq 'iso-2022-jp-2 charsets)
+ (memq 'iso-2022-jp-2 hack-charsets))
+ (setq charsets (delq 'iso-2022-jp charsets)))
+ charsets))
(defmacro mm-with-unibyte-buffer (&rest forms)
"Create a temporary buffer, and evaluate FORMS there like `progn'.
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 / gnus / blobdiff