;;; mm-util.el --- Utility functions for MIME things
-;; Copyright (C) 1998,99 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
;;; Code:
+(require 'mail-prsvr)
+
(defvar mm-mime-mule-charset-alist
'((us-ascii ascii)
(iso-8859-1 latin-iso8859-1)
(iso-8859-3 latin-iso8859-3)
(iso-8859-4 latin-iso8859-4)
(iso-8859-5 cyrillic-iso8859-5)
- (koi8-r cyrillic-iso8859-5)
+ ;; Non-mule (X)Emacs uses the last mule-charset for 8bit characters.
+ ;; The fake mule-charset, gnus-koi8-r, tells Gnus that the default
+ ;; charset is koi8-r, not iso-8859-5.
+ (koi8-r cyrillic-iso8859-5 gnus-koi8-r)
(iso-8859-6 arabic-iso8859-6)
(iso-8859-7 greek-iso8859-7)
(iso-8859-8 hebrew-iso8859-8)
chinese-cns11643-1 chinese-cns11643-2
chinese-cns11643-3 chinese-cns11643-4
chinese-cns11643-5 chinese-cns11643-6
- chinese-cns11643-7))
+ chinese-cns11643-7)
+ (utf-8 unicode-a unicode-b unicode-c unicode-d unicode-e))
"Alist of MIME-charset/MULE-charsets.")
-
(eval-and-compile
(mapcar
(lambda (elem)
prompt (mapcar (lambda (s) (list (symbol-name (car s))))
mm-mime-mule-charset-alist)))))))
+(eval-and-compile
+ (defalias 'mm-char-or-char-int-p
+ (cond
+ ((fboundp 'char-or-char-int-p) 'char-or-char-int-p)
+ ((fboundp 'char-valid-p) 'char-valid-p)
+ (t 'identity))))
+
(defvar mm-coding-system-list nil)
(defun mm-get-coding-system-list ()
"Get the coding system list."
If POS is nil, it defauls to the current point.
If POS is out of range, the value is nil.
If the charset is `composition', return the actual one."
- (let ((charset (charset-after pos)))
+ (let ((charset (cond
+ ((fboundp 'charset-after)
+ (charset-after pos))
+ ((fboundp 'char-charset)
+ (char-charset (char-after pos)))
+ ((< (mm-char-int (char-after pos)) 128)
+ 'ascii)
+ (mail-parse-mule-charset ;; cached mule-charset
+ mail-parse-mule-charset)
+ ((boundp 'current-language-environment)
+ (let ((entry (assoc current-language-environment
+ language-info-alist)))
+ (setq mail-parse-mule-charset
+ (or (car (last (assq 'charset entry)))
+ 'latin-iso8859-1))))
+ (t ;; figure out the charset
+ (setq mail-parse-mule-charset
+ (or (car (last (assq mail-parse-charset
+ mm-mime-mule-charset-alist)))
+ 'latin-iso8859-1))))))
(if (eq charset 'composition)
(let ((p (or pos (point))))
(cadr (find-charset-region p (1+ p))))
(defun mm-mime-charset (charset)
"Return the MIME charset corresponding to the MULE CHARSET."
- (if (fboundp 'coding-system-get)
+ (if (and (fboundp 'coding-system-get) (fboundp 'get-charset-property))
;; This exists in Emacs 20.
(or
(and (mm-preferred-coding-system charset)
;; This is for XEmacs.
(mm-mule-charset-to-mime-charset charset)))
+(defun mm-delete-duplicates (list)
+ "Simple substitute for CL `delete-duplicates', testing with `equal'."
+ (let (result head)
+ (while list
+ (setq head (car list))
+ (setq list (delete head list))
+ (setq result (cons head result)))
+ (nreverse result)))
+
(defun mm-find-mime-charset-region (b e)
"Return the MIME charsets needed to encode the region between B and E."
(let ((charsets (mapcar 'mm-mime-charset
(mm-find-charset-region b e)))))
(when (memq 'iso-2022-jp-2 charsets)
(setq charsets (delq 'iso-2022-jp charsets)))
- (setq charsets (delete-duplicates charsets))
+ (setq charsets (mm-delete-duplicates charsets))
(if (and (> (length charsets) 1)
(fboundp 'find-coding-systems-region)
(memq 'utf-8 (find-coding-systems-region b e)))
(coding-system-for-read mm-binary-coding-system)
(coding-system-for-write mm-binary-coding-system))
(set-buffer-multibyte nil)
+ (setq-default enable-multibyte-characters nil)
,@forms)
+ (setq-default enable-multibyte-characters ,multibyte)
(set-buffer-multibyte ,multibyte))))))
(put 'mm-with-unibyte-current-buffer 'lisp-indent-function 0)
(put 'mm-with-unibyte-current-buffer 'edebug-form-spec '(body))
+(defmacro mm-with-unibyte (&rest forms)
+ "Set default `enable-multibyte-characters' to `nil', eval the FORMS."
+ (let ((multibyte (make-symbol "multibyte")))
+ `(if (or (string-match "XEmacs\\|Lucid" emacs-version)
+ (not (boundp 'enable-multibyte-characters)))
+ (progn ,@forms)
+ (let ((,multibyte (default-value 'enable-multibyte-characters)))
+ (unwind-protect
+ (progn
+ (setq-default enable-multibyte-characters nil)
+ ,@forms)
+ (setq-default enable-multibyte-characters ,multibyte))))))
+(put 'mm-with-unibyte 'lisp-indent-function 0)
+(put 'mm-with-unibyte 'edebug-form-spec '(body))
+
(defun mm-find-charset-region (b e)
"Return a list of charsets in the region."
(cond
(skip-chars-forward "\0-\177")
(if (eobp)
'(ascii)
- (delq nil (list 'ascii mail-parse-charset))))))
+ (delq nil (list 'ascii
+ (or (car (last (assq mail-parse-charset
+ mm-mime-mule-charset-alist)))
+ 'latin-iso8859-1)))))))
(t
;; We are in a unibyte buffer, so we futz around a bit.
(save-excursion
(skip-chars-forward "\0-\177")
(if (eobp)
'(ascii)
- (delq nil (list 'ascii (car (last (assq 'charset entry))))))))))))
+ (delq nil (list 'ascii
+ (or (car (last (assq 'charset entry)))
+ 'latin-iso8859-1))))))))))
(defun mm-read-charset (prompt)
"Return a charset."