;;; mm-util.el --- Utility functions for Mule and low level things
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004
+;; 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)
- (make-char
- . (lambda (charset int)
- (int-to-char int)))
(read-charset
. (lambda (prompt)
"Return a charset."
mm-mime-mule-charset-alist)
nil t))))
(subst-char-in-string
- . (lambda (from to string) ;; stolen (and renamed) from nnheader.el
- "Replace characters in STRING from FROM to TO."
- (let ((string (substring string 0)) ;Copy string.
+ . (lambda (from to string &optional inplace) ;; stolen (and renamed) from nnheader.el
+ "Replace characters in STRING from FROM to TO.
+ Unless optional argument INPLACE is non-nil, return a new string."
+ (let ((string (if inplace string (copy-sequence string)))
(len (length string))
(idx 0))
;; Replace all occurrences of FROM with TO.
(setq idx (1+ idx)))
string)))
(string-as-unibyte . identity)
+ (string-make-unibyte . identity)
(string-as-multibyte . identity)
- (multibyte-string-p . ignore))))
+ (multibyte-string-p . ignore)
+ ;; It is not a MIME function, but some MIME functions use it.
+ (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)))
+ (insert-byte . insert-char)
+ (multibyte-char-to-unibyte . identity))))
(eval-and-compile
(defalias 'mm-char-or-char-int-p
((fboundp 'char-valid-p) 'char-valid-p)
(t 'identity))))
+;; Fixme: This seems always to be used to read a MIME charset, so it
+;; should be re-named and fixed (in Emacs) to offer completion only on
+;; proper charset names (base coding systems which have a
+;; mime-charset defined). XEmacs doesn't believe in mime-charset;
+;; test with
+;; `(or (coding-system-get 'iso-8859-1 'mime-charset)
+;; (coding-system-get 'iso-8859-1 :mime-charset))'
+;; Actually, there should be an `mm-coding-system-mime-charset'.
(eval-and-compile
(defalias 'mm-read-coding-system
(cond
(or mm-coding-system-list
(setq mm-coding-system-list (mm-coding-system-list))))
-(defun mm-coding-system-p (sym)
- "Return non-nil if SYM is a coding system."
- (or (and (fboundp 'coding-system-p) (coding-system-p sym))
- (memq sym (mm-get-coding-system-list))))
+(defun mm-coding-system-p (cs)
+ "Return non-nil if CS is a symbol naming a coding system.
+In XEmacs, also return non-nil if CS is a coding system object."
+ (if (fboundp 'find-coding-system)
+ (find-coding-system cs)
+ (if (fboundp 'coding-system-p)
+ (coding-system-p cs)
+ ;; Is this branch ever actually useful?
+ (memq cs (mm-get-coding-system-list)))))
(defvar mm-charset-synonym-alist
`(
- ;; Perfectly fine? A valid MIME name, anyhow.
- ,@(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)))
- ;; Apparently not defined in Emacs 20, but is a valid MIME name.
- ,@(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 is very similar to ISO-8859-1. But it's _different_!
+ ,@(unless (mm-coding-system-p 'iso-8859-15)
'((iso-8859-15 . iso-8859-1)))
+ ;; BIG-5HKSCS is similar to, but different than, BIG-5.
+ ,@(unless (mm-coding-system-p 'big5-hkscs)
+ '((big5-hkscs . big5)))
;; Windows-1252 is actually a superset of Latin-1. See also
;; `gnus-article-dumbquotes-map'.
,@(unless (mm-coding-system-p 'windows-1252)
,@(if (and (not (mm-coding-system-p 'windows-1250))
(mm-coding-system-p 'cp1250))
'((windows-1250 . cp1250)))
+ ;; A Microsoft misunderstanding.
+ ,@(unless (mm-coding-system-p 'ks_c_5601-1987)
+ (if (mm-coding-system-p 'cp949)
+ '((ks_c_5601-1987 . cp949))
+ '((ks_c_5601-1987 . euc-kr))))
)
"A mapping from invalid charset names to the real charset names.")
(defvar mm-auto-save-coding-system
(cond
+ ((mm-coding-system-p 'utf-8-emacs) ; Mule 7
+ (if (memq system-type '(windows-nt ms-dos ms-windows))
+ (if (mm-coding-system-p 'utf-8-emacs-dos)
+ 'utf-8-emacs-dos mm-binary-coding-system)
+ 'utf-8-emacs))
((mm-coding-system-p 'emacs-mule)
(if (memq system-type '(windows-nt ms-dos ms-windows))
(if (mm-coding-system-p 'emacs-mule-dos)
'nconc
(mapcar
(lambda (cs)
- (when (and (coding-system-get cs 'mime-charset)
+ (when (and (or (coding-system-get cs :mime-charset) ; Emacs 22
+ (coding-system-get cs 'mime-charset))
(not (eq t (coding-system-get cs 'safe-charsets))))
- (list (cons (coding-system-get cs 'mime-charset)
+ (list (cons (or (coding-system-get cs :mime-charset)
+ (coding-system-get cs 'mime-charset))
(delq 'ascii
(coding-system-get cs 'safe-charsets))))))
(sort-coding-systems (coding-system-list 'base-only))))))
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
- "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:
-
-\(setq mm-coding-system-priorities
- '(iso-2022-jp iso-2022-jp-2 japanese-shift-jis utf-8))
-")
-
+(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 messages.
+
+More than one suitable coding system may be found for some text.
+By default, the coding system with the highest priority is used
+to encode outgoing messages (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.
(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)))))
+ (setq mime (or (coding-system-get cs :mime-charset)
+ (coding-system-get cs 'mime-charset))))))
mime)
(let ((alist mm-mime-mule-charset-alist)
out)
((null charset)
charset)
;; Running in a non-MULE environment.
- ((null (mm-get-coding-system-list))
+ ((or (null (mm-get-coding-system-list))
+ (not (fboundp 'coding-system-get)))
charset)
;; ascii
((eq charset 'us-ascii)
;; Do we need -lbt?
(dolist (c (mm-get-coding-system-list))
(if (and (null cs)
- (eq charset (coding-system-get c 'mime-charset)))
+ (eq charset (or (coding-system-get c :mime-charset)
+ (coding-system-get c 'mime-charset))))
(setq cs c)))
cs))))
-(defsubst mm-replace-chars-in-string (string from to)
- (mm-subst-char-in-string from to string))
-
(eval-and-compile
(defvar mm-emacs-mule (and (not (featurep 'xemacs))
(boundp 'default-enable-multibyte-characters)
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)))
- "Mule version 4.")
+ "True in Emacs with Mule.")
(if mm-emacs-mule
(defun mm-enable-multibyte ()
"Set the multibyte flag of the current buffer.
Only do this if the default value of `enable-multibyte-characters' is
non-nil. This is a no-op in XEmacs."
- (set-buffer-multibyte t))
+ (set-buffer-multibyte 'to))
(defalias 'mm-enable-multibyte 'ignore))
(if mm-emacs-mule
"Unset the multibyte flag of in the current buffer.
This is a no-op in XEmacs."
(set-buffer-multibyte nil))
- (defalias 'mm-disable-multibyte 'ignore))
-
- (if mm-mule4-p
- (defun mm-enable-multibyte-mule4 ()
- "Enable multibyte in the current buffer.
-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.
-Only used in Emacs Mule 4."
- (set-buffer-multibyte nil))
- (defalias 'mm-disable-multibyte-mule4 'ignore)))
+ (defalias 'mm-disable-multibyte 'ignore)))
(defun mm-preferred-coding-system (charset)
;; A typo in some Emacs versions.
(or (get-charset-property charset 'preferred-coding-system)
(get-charset-property charset 'prefered-coding-system)))
+;; Mule charsets shouldn't be used.
(defsubst mm-guess-charset ()
"Guess Mule charset from the language environment."
(or
(setq charset 'ascii)
;; charset-after is fake in some Emacsen.
(setq charset (and (fboundp 'char-charset) (char-charset char)))
- (if (eq charset 'composition)
+ (if (eq charset 'composition) ; Mule 4
(let ((p (or pos (point))))
(cadr (find-charset-region p (1+ p))))
(if (and charset (not (memq charset '(ascii eight-bit-control
;; This exists in Emacs 20.
(or
(and (mm-preferred-coding-system charset)
- (coding-system-get
- (mm-preferred-coding-system charset) 'mime-charset))
+ (or (coding-system-get
+ (mm-preferred-coding-system charset) :mime-charset)
+ (coding-system-get
+ (mm-preferred-coding-system charset) 'mime-charset)))
(and (eq charset 'ascii)
'us-ascii)
(mm-preferred-coding-system 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)))
-(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))))
+;; Fixme: This is used in places when it should be testing the
+;; default multibyteness. See mm-default-multibyte-p.
+(eval-and-compile
+ (if (and (not (featurep 'xemacs))
+ (boundp 'enable-multibyte-characters))
+ (defun mm-multibyte-p ()
+ "Non-nil if multibyte is enabled in the current buffer."
+ enable-multibyte-characters)
+ (defun mm-multibyte-p () (featurep 'mule))))
+
+(defun mm-default-multibyte-p ()
+ "Return non-nil if the session is multibyte.
+This affects whether coding conversion should be attempted generally."
+ (if (featurep 'mule)
+ (if (boundp 'default-enable-multibyte-characters)
+ default-enable-multibyte-characters
+ t)))
(defun mm-iso-8859-x-to-15-region (&optional b e)
(if (fboundp 'char-charset)
(forward-char))
(t
(insert-before-markers (prog1 (+ c (car (cdr item)))
- (delete-char 1))))
- (skip-chars-forward "\0-\177"))))
+ (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))))
+ (let ((priorities
+ (mapcar (lambda (cs)
+ ;; Note: invalid entries are dropped silently
+ (and (coding-system-p cs)
+ (coding-system-base cs)))
+ mm-coding-system-priorities)))
+ (> (length (memq a priorities))
+ (length (memq b 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.
(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
+ (let* ((head (pop systems))
+ (cs (or (coding-system-get head :mime-charset)
+ (coding-system-get head 'mime-charset))))
+ ;; The mime-charset (`x-ctext') of
+ ;; `compound-text' is not in the IANA list. We
+ ;; shouldn't normally use anything here with a
+ ;; mime-charset having an `x-' prefix.
+ ;; Fixme: Allow this to be overridden, since
+ ;; there is existing use of x-ctext.
+ ;; Also people apparently need the coding system
+ ;; `iso-2022-jp-3' (which Mule-UCS defines with
+ ;; mime-charset, though it's not valid).
+ (if (and cs
+ (not (string-match "^[Xx]-" (symbol-name cs)))
+ ;; UTF-16 of any variety is invalid for
+ ;; text parts and, unfortunately, has
+ ;; mime-charset defined both in Mule-UCS
+ ;; and versions of Emacs. (The name
+ ;; might be `mule-utf-16...' or
+ ;; `utf-16...'.)
+ (not (string-match "utf-16" (symbol-name cs))))
(setq systems nil
charsets (list cs))))))
charsets))
- ;; Otherwise we're not multibyte, XEmacs or a single coding
- ;; system won't cover it.
+ ;; Otherwise we're not multibyte, we're 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 (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)))
projects / gnus / blobdiff