;;; mm-util.el --- Utility functions for Mule and low level things
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005
-;; Free Software Foundation, Inc.
+
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
+;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
+;; For Emacs < 22.2.
+(eval-and-compile
+ (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
+
(eval-when-compile (require 'cl))
(require 'mail-prsvr)
(eval-and-compile
- (mapcar
+ (if (featurep 'xemacs)
+ (unless (ignore-errors
+ (require 'timer-funcs))
+ (require 'timer))
+ (require 'timer)))
+
+(defvar mm-mime-mule-charset-alist )
+
+;; Emulate functions that are not available in every (X)Emacs version.
+;; The name of a function is prefixed with mm-, like `mm-char-int' for
+;; `char-int' that is a native XEmacs function, not available in Emacs.
+;; Gnus programs all should use mm- functions, not the original ones.
+(eval-and-compile
+ (mapc
(lambda (elem)
(let ((nfunc (intern (format "mm-%s" (car elem)))))
(if (fboundp (car elem))
(defalias nfunc (car elem))
(defalias nfunc (cdr elem)))))
- '((decode-coding-string . (lambda (s a) s))
- (encode-coding-string . (lambda (s a) s))
- (encode-coding-region . ignore)
+ `(;; `coding-system-list' is not available in XEmacs 21.4 built
+ ;; without the `file-coding' feature.
(coding-system-list . ignore)
- (decode-coding-region . ignore)
+ ;; `char-int' is an XEmacs function, not available in Emacs.
(char-int . identity)
+ ;; `coding-system-equal' is an Emacs function, not available in XEmacs.
(coding-system-equal . equal)
+ ;; `annotationp' is an XEmacs function, not available in Emacs.
(annotationp . ignore)
+ ;; `set-buffer-file-coding-system' is not available in XEmacs 21.4
+ ;; built without the `file-coding' feature.
(set-buffer-file-coding-system . ignore)
+ ;; `read-charset' is an Emacs function, not available in XEmacs.
(read-charset
- . (lambda (prompt)
- "Return a charset."
- (intern
- (completing-read
- prompt
- (mapcar (lambda (e) (list (symbol-name (car e))))
- mm-mime-mule-charset-alist)
- nil t))))
+ . ,(lambda (prompt)
+ "Return a charset."
+ (intern
+ (completing-read
+ prompt
+ (mapcar (lambda (e) (list (symbol-name (car e))))
+ mm-mime-mule-charset-alist)
+ nil t))))
+ ;; `subst-char-in-string' is not available in XEmacs 21.4.
(subst-char-in-string
- . (lambda (from to string &optional inplace)
- ;; stolen (and renamed) from nnheader.el
- "Replace characters in STRING from FROM to TO.
+ . ,(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.
- (while (< idx len)
- (when (= (aref string idx) from)
- (aset string idx to))
- (setq idx (1+ idx)))
- string)))
+ (let ((string (if inplace string (copy-sequence string)))
+ (len (length string))
+ (idx 0))
+ ;; Replace all occurrences of FROM with TO.
+ (while (< idx len)
+ (when (= (aref string idx) from)
+ (aset string idx to))
+ (setq idx (1+ idx)))
+ string)))
+ ;; `replace-in-string' is an XEmacs function, not available in Emacs.
(replace-in-string
- . (lambda (string regexp rep &optional literal)
- "See `replace-regexp-in-string', only the order of args differs."
- (replace-regexp-in-string regexp rep string nil literal)))
+ . ,(lambda (string regexp rep &optional literal)
+ "See `replace-regexp-in-string', only the order of args differs."
+ (replace-regexp-in-string regexp rep string nil literal)))
+ ;; `string-as-unibyte' is an Emacs function, not available in XEmacs.
(string-as-unibyte . identity)
+ ;; `string-make-unibyte' is an Emacs function, not available in XEmacs.
(string-make-unibyte . identity)
;; string-as-multibyte often doesn't really do what you think it does.
;; Example:
;; (string-as-multibyte s) ~= (decode-coding-string s 'emacs-mule)
;; (string-to-multibyte s) ~= (decode-coding-string s 'binary)
;; (string-make-multibyte s) ~= (decode-coding-string s locale-coding-system)
+ ;; `string-as-multibyte' is an Emacs function, not available in XEmacs.
(string-as-multibyte . identity)
- (string-to-multibyte
- . (lambda (string)
- "Return a multibyte string with the same individual chars as string."
- (mapconcat
- (lambda (ch) (mm-string-as-multibyte (char-to-string ch)))
- string "")))
+ ;; `multibyte-string-p' is an Emacs function, not available in XEmacs.
(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' is available only in Emacs 23.1 or greater.
(insert-byte . insert-char)
- (multibyte-char-to-unibyte . identity))))
+ ;; `multibyte-char-to-unibyte' is an Emacs function, not available
+ ;; in XEmacs.
+ (multibyte-char-to-unibyte . identity)
+ ;; `set-buffer-multibyte' is an Emacs function, not available in XEmacs.
+ (set-buffer-multibyte . ignore)
+ ;; `special-display-p' is an Emacs function, not available in XEmacs.
+ (special-display-p
+ . ,(lambda (buffer-name)
+ "Returns non-nil if a buffer named BUFFER-NAME gets a special frame."
+ (and special-display-function
+ (or (and (member buffer-name special-display-buffer-names) t)
+ (cdr (assoc buffer-name special-display-buffer-names))
+ (catch 'return
+ (dolist (elem special-display-regexps)
+ (and (stringp elem)
+ (string-match elem buffer-name)
+ (throw 'return t))
+ (and (consp elem)
+ (stringp (car elem))
+ (string-match (car elem) buffer-name)
+ (throw 'return (cdr elem)))))))))
+ ;; `substring-no-properties' is available only in Emacs 22.1 or greater.
+ (substring-no-properties
+ . ,(lambda (string &optional from to)
+ "Return a substring of STRING, without text properties.
+It starts at index FROM and ending before TO.
+TO may be nil or omitted; then the substring runs to the end of STRING.
+If FROM is nil or omitted, the substring starts at the beginning of STRING.
+If FROM or TO is negative, it counts from the end.
+
+With one argument, just copy STRING without its properties."
+ (setq string (substring string (or from 0) to))
+ (set-text-properties 0 (length string) nil string)
+ string))
+ ;; `line-number-at-pos' is available only in Emacs 22.1 or greater
+ ;; and XEmacs 21.5.
+ (line-number-at-pos
+ . ,(lambda (&optional pos)
+ "Return (narrowed) buffer line number at position POS.
+If POS is nil, use current buffer location.
+Counting starts at (point-min), so the value refers
+to the contents of the accessible portion of the buffer."
+ (let ((opoint (or pos (point))) start)
+ (save-excursion
+ (goto-char (point-min))
+ (setq start (point))
+ (goto-char opoint)
+ (forward-line 0)
+ (1+ (count-lines start (point))))))))))
+
+;; `decode-coding-string', `encode-coding-string', `decode-coding-region'
+;; and `encode-coding-region' are available in Emacs and XEmacs built with
+;; the `file-coding' feature, but the XEmacs versions treat nil, that is
+;; given as the `coding-system' argument, as the `binary' coding system.
+(eval-and-compile
+ (if (featurep 'xemacs)
+ (if (featurep 'file-coding)
+ (progn
+ (defun mm-decode-coding-string (str coding-system)
+ (if coding-system
+ (decode-coding-string str coding-system)
+ str))
+ (defun mm-encode-coding-string (str coding-system)
+ (if coding-system
+ (encode-coding-string str coding-system)
+ str))
+ (defun mm-decode-coding-region (start end coding-system)
+ (if coding-system
+ (decode-coding-region start end coding-system)))
+ (defun mm-encode-coding-region (start end coding-system)
+ (if coding-system
+ (encode-coding-region start end coding-system))))
+ (defun mm-decode-coding-string (str coding-system) str)
+ (defun mm-encode-coding-string (str coding-system) str)
+ (defalias 'mm-decode-coding-region 'ignore)
+ (defalias 'mm-encode-coding-region 'ignore))
+ (defalias 'mm-decode-coding-string 'decode-coding-string)
+ (defalias 'mm-encode-coding-string 'encode-coding-string)
+ (defalias 'mm-decode-coding-region 'decode-coding-region)
+ (defalias 'mm-encode-coding-region 'encode-coding-region)))
+
+;; `string-to-multibyte' is available only in Emacs 22.1 or greater.
+(defalias 'mm-string-to-multibyte
+ (cond
+ ((featurep 'xemacs)
+ 'identity)
+ ((fboundp 'string-to-multibyte)
+ 'string-to-multibyte)
+ (t
+ (lambda (string)
+ "Return a multibyte string with the same individual chars as STRING."
+ (mapconcat
+ (lambda (ch) (mm-string-as-multibyte (char-to-string ch)))
+ string "")))))
+;; `char-or-char-int-p' is an XEmacs function, not available in Emacs.
(eval-and-compile
(defalias 'mm-char-or-char-int-p
(cond
((fboundp 'char-valid-p) 'char-valid-p)
(t 'identity))))
+;; `ucs-to-char' is a function that Mule-UCS provides.
+(if (featurep 'xemacs)
+ (cond ((and (fboundp 'unicode-to-char) ;; XEmacs 21.5.
+ (subrp (symbol-function 'unicode-to-char)))
+ (if (featurep 'mule)
+ (defalias 'mm-ucs-to-char 'unicode-to-char)
+ (defun mm-ucs-to-char (codepoint)
+ "Convert Unicode codepoint to character."
+ (or (unicode-to-char codepoint) ?#))))
+ ((featurep 'mule)
+ (defun mm-ucs-to-char (codepoint)
+ "Convert Unicode codepoint to character."
+ (if (fboundp 'ucs-to-char) ;; Mule-UCS is loaded.
+ (progn
+ (defalias 'mm-ucs-to-char
+ (lambda (codepoint)
+ "Convert Unicode codepoint to character."
+ (condition-case nil
+ (or (ucs-to-char codepoint) ?#)
+ (error ?#))))
+ (mm-ucs-to-char codepoint))
+ (condition-case nil
+ (or (int-to-char codepoint) ?#)
+ (error ?#)))))
+ (t
+ (defun mm-ucs-to-char (codepoint)
+ "Convert Unicode codepoint to character."
+ (condition-case nil
+ (or (int-to-char codepoint) ?#)
+ (error ?#)))))
+ (if (let ((char (make-char 'japanese-jisx0208 36 34)))
+ (eq char (decode-char 'ucs char)))
+ ;; Emacs 23.
+ (defalias 'mm-ucs-to-char 'identity)
+ (defun mm-ucs-to-char (codepoint)
+ "Convert Unicode codepoint to character."
+ (or (decode-char 'ucs codepoint) ?#))))
+
;; 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
(if (fboundp 'coding-system-p)
(when (coding-system-p cs)
cs)
- ;; Is this branch ever actually useful?
+ ;; no-MULE XEmacs:
(car (memq cs (mm-get-coding-system-list))))))
+(defun mm-codepage-setup (number &optional alias)
+ "Create a coding system cpNUMBER.
+The coding system is created using `codepage-setup'. If ALIAS is
+non-nil, an alias is created and added to
+`mm-charset-synonym-alist'. If ALIAS is a string, it's used as
+the alias. Else windows-NUMBER is used."
+ (interactive
+ (let ((completion-ignore-case t)
+ (candidates (if (fboundp 'cp-supported-codepages)
+ (cp-supported-codepages)
+ ;; Removed in Emacs 23 (unicode), so signal an error:
+ (error "`codepage-setup' not present in this Emacs version"))))
+ (list (completing-read "Setup DOS Codepage: (default 437) " candidates
+ nil t nil nil "437"))))
+ (when alias
+ (setq alias (if (stringp alias)
+ (intern alias)
+ (intern (format "windows-%s" number)))))
+ (let* ((cp (intern (format "cp%s" number))))
+ (unless (mm-coding-system-p cp)
+ (if (fboundp 'codepage-setup) ; silence compiler
+ (codepage-setup number)
+ (error "`codepage-setup' not present in this Emacs version")))
+ (when (and alias
+ ;; Don't add alias if setup of cp failed.
+ (mm-coding-system-p cp))
+ (add-to-list 'mm-charset-synonym-alist (cons alias cp)))))
+
(defvar mm-charset-synonym-alist
`(
;; Not in XEmacs, but it's not a proper MIME charset anyhow.
,@(unless (mm-coding-system-p 'x-ctext)
- '((x-ctext . ctext)))
- ;; ISO-8859-15 is very similar to ISO-8859-1. But it's _different_!
+ '((x-ctext . ctext)))
+ ;; ISO-8859-15 is very similar to ISO-8859-1. But it's _different_ in 8
+ ;; positions!
,@(unless (mm-coding-system-p 'iso-8859-15)
- '((iso-8859-15 . iso-8859-1)))
+ '((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 (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.
- ,@(if (and (not (mm-coding-system-p 'windows-1250))
- (mm-coding-system-p 'cp1250))
- '((windows-1250 . cp1250)))
;; A Microsoft misunderstanding.
- ,@(if (and (not (mm-coding-system-p 'unicode))
- (mm-coding-system-p 'utf-16-le))
- '((unicode . utf-16-le)))
+ ,@(when (and (not (mm-coding-system-p 'unicode))
+ (mm-coding-system-p 'utf-16-le))
+ '((unicode . utf-16-le)))
;; 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))))
+ ;; Windows-31J is Windows Codepage 932.
+ ,@(when (and (not (mm-coding-system-p 'windows-31j))
+ (mm-coding-system-p 'cp932))
+ '((windows-31j . cp932)))
+ ;; Charset name: GBK, Charset aliases: CP936, MS936, windows-936
+ ;; http://www.iana.org/assignments/charset-reg/GBK
+ ;; Emacs 22.1 has cp936, but not gbk, so we alias it:
+ ,@(when (and (not (mm-coding-system-p 'gbk))
+ (mm-coding-system-p 'cp936))
+ '((gbk . cp936)))
+ ;; UTF8 is a bogus name for UTF-8
+ ,@(when (and (not (mm-coding-system-p 'utf8))
+ (mm-coding-system-p 'utf-8))
+ '((utf8 . utf-8)))
+ ;; ISO8859-1 is a bogus name for ISO-8859-1
+ ,@(when (and (not (mm-coding-system-p 'iso8859-1))
+ (mm-coding-system-p 'iso-8859-1))
+ '((iso8859-1 . iso-8859-1)))
+ ;; ISO_8859-1 is a bogus name for ISO-8859-1
+ ,@(when (and (not (mm-coding-system-p 'iso_8859-1))
+ (mm-coding-system-p 'iso-8859-1))
+ '((iso_8859-1 . iso-8859-1)))
)
- "A mapping from invalid charset names to the real charset names.")
+ "A mapping from unknown or invalid charset names to the real charset names.
+
+See `mm-codepage-iso-8859-list' and `mm-codepage-ibm-list'.")
+
+(defcustom mm-codepage-iso-8859-list
+ (list 1250 ;; 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
+ ;; (Emacs 21).
+ '(1252 . 1) ;; Windows-1252 is a superset of iso-8859-1 (West
+ ;; Europe). See also `gnus-article-dumbquotes-map'.
+ '(1254 . 9) ;; Windows-1254 is a superset of iso-8859-9 (Turkish).
+ '(1255 . 8));; Windows-1255 is a superset of iso-8859-8 (Hebrew).
+ "A list of Windows codepage numbers and iso-8859 charset numbers.
+
+If an element is a number corresponding to a supported windows
+codepage, appropriate entries to `mm-charset-synonym-alist' are
+added by `mm-setup-codepage-iso-8859'. An element may also be a
+cons cell where the car is a codepage number and the cdr is the
+corresponding number of an iso-8859 charset."
+ :type '(list (set :inline t
+ (const 1250 :tag "Central and East European")
+ (const (1252 . 1) :tag "West European")
+ (const (1254 . 9) :tag "Turkish")
+ (const (1255 . 8) :tag "Hebrew"))
+ (repeat :inline t
+ :tag "Other options"
+ (choice
+ (integer :tag "Windows codepage number")
+ (cons (integer :tag "Windows codepage number")
+ (integer :tag "iso-8859 charset number")))))
+ :version "22.1" ;; Gnus 5.10.9
+ :group 'mime)
+
+(defcustom mm-codepage-ibm-list
+ (list 437 ;; (US etc.)
+ 860 ;; (Portugal)
+ 861 ;; (Iceland)
+ 862 ;; (Israel)
+ 863 ;; (Canadian French)
+ 865 ;; (Nordic)
+ 852 ;;
+ 850 ;; (Latin 1)
+ 855 ;; (Cyrillic)
+ 866 ;; (Cyrillic - Russian)
+ 857 ;; (Turkish)
+ 864 ;; (Arabic)
+ 869 ;; (Greek)
+ 874);; (Thai)
+ ;; In Emacs 23 (unicode), cp... and ibm... are aliases.
+ ;; Cf. http://thread.gmane.org/v9lkng5nwy.fsf@marauder.physik.uni-ulm.de
+ "List of IBM codepage numbers.
+
+The codepage mappings slighly differ between IBM and other vendors.
+See \"ftp://ftp.unicode.org/Public/MAPPINGS/VENDORS/IBM/README.TXT\".
+
+If an element is a number corresponding to a supported windows
+codepage, appropriate entries to `mm-charset-synonym-alist' are
+added by `mm-setup-codepage-ibm'."
+ :type '(list (set :inline t
+ (const 437 :tag "US etc.")
+ (const 860 :tag "Portugal")
+ (const 861 :tag "Iceland")
+ (const 862 :tag "Israel")
+ (const 863 :tag "Canadian French")
+ (const 865 :tag "Nordic")
+ (const 852)
+ (const 850 :tag "Latin 1")
+ (const 855 :tag "Cyrillic")
+ (const 866 :tag "Cyrillic - Russian")
+ (const 857 :tag "Turkish")
+ (const 864 :tag "Arabic")
+ (const 869 :tag "Greek")
+ (const 874 :tag "Thai"))
+ (repeat :inline t
+ :tag "Other options"
+ (integer :tag "Codepage number")))
+ :version "22.1" ;; Gnus 5.10.9
+ :group 'mime)
+
+(defun mm-setup-codepage-iso-8859 (&optional list)
+ "Add appropriate entries to `mm-charset-synonym-alist'.
+Unless LIST is given, `mm-codepage-iso-8859-list' is used."
+ (unless list
+ (setq list mm-codepage-iso-8859-list))
+ (dolist (i list)
+ (let (cp windows iso)
+ (if (consp i)
+ (setq cp (intern (format "cp%d" (car i)))
+ windows (intern (format "windows-%d" (car i)))
+ iso (intern (format "iso-8859-%d" (cdr i))))
+ (setq cp (intern (format "cp%d" i))
+ windows (intern (format "windows-%d" i))))
+ (unless (mm-coding-system-p windows)
+ (if (mm-coding-system-p cp)
+ (add-to-list 'mm-charset-synonym-alist (cons windows cp))
+ (add-to-list 'mm-charset-synonym-alist (cons windows iso)))))))
+
+(defun mm-setup-codepage-ibm (&optional list)
+ "Add appropriate entries to `mm-charset-synonym-alist'.
+Unless LIST is given, `mm-codepage-ibm-list' is used."
+ (unless list
+ (setq list mm-codepage-ibm-list))
+ (dolist (number list)
+ (let ((ibm (intern (format "ibm%d" number)))
+ (cp (intern (format "cp%d" number))))
+ (when (and (not (mm-coding-system-p ibm))
+ (mm-coding-system-p cp))
+ (add-to-list 'mm-charset-synonym-alist (cons ibm cp))))))
+
+;; Initialize:
+(mm-setup-codepage-iso-8859)
+(mm-setup-codepage-ibm)
+
+;; Note: this has to be defined before `mm-charset-to-coding-system'.
+(defcustom mm-charset-eval-alist
+ (if (featurep 'xemacs)
+ nil ;; I don't know what would be useful for XEmacs.
+ '(;; Emacs 21 offers 1250 1251 1253 1257. Emacs 22 provides autoloads for
+ ;; 1250-1258 (i.e. `mm-codepage-setup' does nothing).
+ (windows-1250 . (mm-codepage-setup 1250 t))
+ (windows-1251 . (mm-codepage-setup 1251 t))
+ (windows-1253 . (mm-codepage-setup 1253 t))
+ (windows-1257 . (mm-codepage-setup 1257 t))))
+ "An alist of (CHARSET . FORM) pairs.
+If an article is encoded in an unknown CHARSET, FORM is
+evaluated. This allows to load additional libraries providing
+charsets on demand. If supported by your Emacs version, you
+could use `autoload-coding-system' here."
+ :version "22.1" ;; Gnus 5.10.9
+ :type '(list (set :inline t
+ (const (windows-1250 . (mm-codepage-setup 1250 t)))
+ (const (windows-1251 . (mm-codepage-setup 1251 t)))
+ (const (windows-1253 . (mm-codepage-setup 1253 t)))
+ (const (windows-1257 . (mm-codepage-setup 1257 t)))
+ (const (cp850 . (mm-codepage-setup 850 nil))))
+ (repeat :inline t
+ :tag "Other options"
+ (cons (symbol :tag "charset")
+ (symbol :tag "form"))))
+ :group 'mime)
+(put 'mm-charset-eval-alist 'risky-local-variable t)
+
+(defvar mm-charset-override-alist)
+
+;; Note: this function has to be defined before `mm-charset-override-alist'
+;; since it will use this function in order to determine its default value
+;; when loading mm-util.elc.
+(defun mm-charset-to-coding-system (charset &optional lbt
+ allow-override silent)
+ "Return coding-system corresponding to CHARSET.
+CHARSET is a symbol naming a MIME charset.
+If optional argument LBT (`unix', `dos' or `mac') is specified, it is
+used as the line break code type of the coding system.
+
+If ALLOW-OVERRIDE is given, use `mm-charset-override-alist' to
+map undesired charset names to their replacement. This should
+only be used for decoding, not for encoding.
+
+A non-nil value of SILENT means don't issue a warning even if CHARSET
+is not available."
+ ;; OVERRIDE is used (only) in `mm-decode-body' and `mm-decode-string'.
+ (when (stringp charset)
+ (setq charset (intern (downcase charset))))
+ (when lbt
+ (setq charset (intern (format "%s-%s" charset lbt))))
+ (cond
+ ((null charset)
+ charset)
+ ;; Running in a non-MULE environment.
+ ((or (null (mm-get-coding-system-list))
+ (not (fboundp 'coding-system-get)))
+ charset)
+ ;; Check override list quite early. Should only used for decoding, not for
+ ;; encoding!
+ ((and allow-override
+ (let ((cs (cdr (assq charset mm-charset-override-alist))))
+ (and cs (mm-coding-system-p cs) cs))))
+ ;; ascii
+ ((eq charset 'us-ascii)
+ 'ascii)
+ ;; Check to see whether we can handle this charset. (This depends
+ ;; on there being some coding system matching each `mime-charset'
+ ;; property defined, as there should be.)
+ ((and (mm-coding-system-p charset)
+;;; Doing this would potentially weed out incorrect charsets.
+;;; charset
+;;; (eq charset (coding-system-get charset 'mime-charset))
+ )
+ charset)
+ ;; Use coding system Emacs knows.
+ ((and (fboundp 'coding-system-from-name)
+ (coding-system-from-name charset)))
+ ;; Eval expressions from `mm-charset-eval-alist'
+ ((let* ((el (assq charset mm-charset-eval-alist))
+ (cs (car el))
+ (form (cdr el)))
+ (and cs
+ form
+ (prog2
+ ;; Avoid errors...
+ (condition-case nil (eval form) (error nil))
+ ;; (message "Failed to eval `%s'" form))
+ (mm-coding-system-p cs)
+ (message "Added charset `%s' via `mm-charset-eval-alist'" cs))
+ cs)))
+ ;; Translate invalid charsets.
+ ((let ((cs (cdr (assq charset mm-charset-synonym-alist))))
+ (and cs
+ (mm-coding-system-p cs)
+ ;; (message
+ ;; "Using synonym `%s' from `mm-charset-synonym-alist' for `%s'"
+ ;; cs charset)
+ 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).
+ ((let (cs)
+ ;; mm-get-coding-system-list returns a list of cs without lbt.
+ ;; Do we need -lbt?
+ (dolist (c (mm-get-coding-system-list))
+ (if (and (null cs)
+ (eq charset (or (coding-system-get c :mime-charset)
+ (coding-system-get c 'mime-charset))))
+ (setq cs c)))
+ (unless (or silent cs)
+ ;; Warn the user about unknown charset:
+ (if (fboundp 'gnus-message)
+ (gnus-message 7 "Unknown charset: %s" charset)
+ (message "Unknown charset: %s" charset)))
+ cs))))
+
+;; Note: `mm-charset-to-coding-system' has to be defined before this.
+(defcustom mm-charset-override-alist
+ ;; Note: pairs that cannot be used in the Emacs version currently running
+ ;; will be removed.
+ '((gb2312 . gbk)
+ (iso-8859-1 . windows-1252)
+ (iso-8859-8 . windows-1255)
+ (iso-8859-9 . windows-1254))
+ "A mapping from undesired charset names to their replacement.
+
+You may add pairs like (iso-8859-1 . windows-1252) here,
+i.e. treat iso-8859-1 as windows-1252. windows-1252 is a
+superset of iso-8859-1."
+ :type
+ '(list
+ :convert-widget
+ (lambda (widget)
+ (let ((defaults
+ (delq nil
+ (mapcar (lambda (pair)
+ (if (mm-charset-to-coding-system (cdr pair)
+ nil nil t)
+ pair))
+ '((gb2312 . gbk)
+ (iso-8859-1 . windows-1252)
+ (iso-8859-8 . windows-1255)
+ (iso-8859-9 . windows-1254)
+ (undecided . windows-1252)))))
+ (val (copy-sequence (default-value 'mm-charset-override-alist)))
+ pair rest)
+ (while val
+ (push (if (and (prog1
+ (setq pair (assq (caar val) defaults))
+ (setq defaults (delq pair defaults)))
+ (equal (car val) pair))
+ `(const ,pair)
+ `(cons :format "%v"
+ (const :format "(%v" ,(caar val))
+ (symbol :size 3 :format " . %v)\n" ,(cdar val))))
+ rest)
+ (setq val (cdr val)))
+ (while defaults
+ (push `(const ,(pop defaults)) rest))
+ (widget-convert
+ 'list
+ `(set :inline t :format "%v" ,@(nreverse rest))
+ `(repeat :inline t :tag "Other options"
+ (cons :format "%v"
+ (symbol :size 3 :format "(%v")
+ (symbol :size 3 :format " . %v)\n")))))))
+ ;; Remove pairs that cannot be used in the Emacs version currently
+ ;; running. Note that this section will be evaluated when loading
+ ;; mm-util.elc.
+ :set (lambda (symbol value)
+ (custom-set-default
+ symbol (delq nil
+ (mapcar (lambda (pair)
+ (if (mm-charset-to-coding-system (cdr pair)
+ nil nil t)
+ pair))
+ value))))
+ :version "22.1" ;; Gnus 5.10.9
+ :group 'mime)
(defvar mm-binary-coding-system
(cond
"100% binary coding system.")
(defvar mm-text-coding-system
- (or (if (memq system-type '(windows-nt ms-dos ms-windows))
+ (or (if (memq system-type '(windows-nt ms-dos))
(and (mm-coding-system-p 'raw-text-dos) 'raw-text-dos)
(and (mm-coding-system-p 'raw-text) 'raw-text))
mm-binary-coding-system)
(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 (memq system-type '(windows-nt ms-dos))
(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 (memq system-type '(windows-nt ms-dos))
(if (mm-coding-system-p 'emacs-mule-dos)
'emacs-mule-dos mm-binary-coding-system)
'emacs-mule))
(iso-2022-jp latin-jisx0201 japanese-jisx0208 japanese-jisx0208-1978)
(euc-kr korean-ksc5601)
(gb2312 chinese-gb2312)
+ (gbk chinese-gbk)
+ (gb18030 gb18030-2-byte
+ gb18030-4-byte-bmp gb18030-4-byte-smp
+ gb18030-4-byte-ext-1 gb18030-4-byte-ext-2)
(big5 chinese-big5-1 chinese-big5-2)
(tibetan tibetan)
(thai-tis620 thai-tis620)
(iso-2022-jp-3 latin-jisx0201 japanese-jisx0208-1978 japanese-jisx0208
japanese-jisx0213-1 japanese-jisx0213-2)
(shift_jis latin-jisx0201 katakana-jisx0201 japanese-jisx0208)
- ,(if (or (not (fboundp 'charsetp)) ;; non-Mule case
- (charsetp 'unicode-a)
- (not (mm-coding-system-p 'mule-utf-8)))
- '(utf-8 unicode-a unicode-b unicode-c unicode-d unicode-e)
- ;; If we have utf-8 we're in Mule 5+.
- (append '(utf-8)
- (delete 'ascii
- (coding-system-get 'mule-utf-8 'safe-charsets)))))
+ ,(cond ((fboundp 'unicode-precedence-list)
+ (cons 'utf-8 (delq 'ascii (mapcar 'charset-name
+ (unicode-precedence-list)))))
+ ((or (not (fboundp 'charsetp)) ;; non-Mule case
+ (charsetp 'unicode-a)
+ (not (mm-coding-system-p 'mule-utf-8)))
+ '(utf-8 unicode-a unicode-b unicode-c unicode-d unicode-e))
+ (t ;; If we have utf-8 we're in Mule 5+.
+ (append '(utf-8)
+ (delete 'ascii
+ (coding-system-get 'mule-utf-8 'safe-charsets))))))
"Alist of MIME-charset/MULE-charsets.")
(defun mm-enrich-utf-8-by-mule-ucs ()
This function will run when the `un-define' module is loaded under
XEmacs, and fill the `utf-8' entry in `mm-mime-mule-charset-alist'
with Mule charsets. It is completely useless for Emacs."
- (unless (cdr (delete '(mm-enrich-utf-8-by-mule-ucs)
- (assoc "un-define" after-load-alist)))
- (setq after-load-alist
- (delete '("un-define") after-load-alist)))
(when (boundp 'unicode-basic-translation-charset-order-list)
(condition-case nil
(let ((val (delq
cs mime mule alist)
(while css
(setq cs (pop css)
- mime (or (coding-system-get cs :mime-charset) ; Emacs 22
+ mime (or (coding-system-get cs :mime-charset); Emacs 23 (unicode)
(coding-system-get cs 'mime-charset)))
(when (and mime
(not (eq t (setq mule
"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 prefer iso-2022-jp to euc-japan or
- ;; shift_jis, however iso-8859-1 should be used when
- ;; there are only ASCII text and Latin-1 characters.
- '(iso-8859-1 iso-2022-jp iso-2022-jp-2 shift_jis utf-8)))))
+ (let ((lang (if (boundp 'current-language-environment)
+ (symbol-value 'current-language-environment))))
+ (cond (;; XEmacs without Mule but with `file-coding'.
+ (not lang) nil)
+ ;; In XEmacs 21.5 it may be the one like "Japanese (UTF-8)".
+ ((string-match "\\`Japanese" lang)
+ ;; Japanese users prefer iso-2022-jp to euc-japan or
+ ;; shift_jis, however iso-8859-1 should be used when
+ ;; there are only ASCII text and Latin-1 characters.
+ '(iso-8859-1 iso-2022-jp iso-2022-jp-2 shift_jis utf-8))))
"Preferred coding systems for encoding outgoing messages.
More than one suitable coding system may be found for some text.
(pop alist))
out)))
-(defun mm-charset-to-coding-system (charset &optional lbt)
- "Return coding-system corresponding to CHARSET.
-CHARSET is a symbol naming a MIME charset.
-If optional argument LBT (`unix', `dos' or `mac') is specified, it is
-used as the line break code type of the coding system."
- (when (stringp charset)
- (setq charset (intern (downcase charset))))
- (when lbt
- (setq charset (intern (format "%s-%s" charset lbt))))
- (cond
- ((null charset)
- charset)
- ;; Running in a non-MULE environment.
- ((or (null (mm-get-coding-system-list))
- (not (fboundp 'coding-system-get)))
- charset)
- ;; ascii
- ((eq charset 'us-ascii)
- 'ascii)
- ;; Check to see whether we can handle this charset. (This depends
- ;; on there being some coding system matching each `mime-charset'
- ;; property defined, as there should be.)
- ((and (mm-coding-system-p charset)
-;;; Doing this would potentially weed out incorrect charsets.
-;;; charset
-;;; (eq charset (coding-system-get charset 'mime-charset))
- )
- charset)
- ;; Translate invalid charsets.
- ((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).
- ((let (cs)
- ;; mm-get-coding-system-list returns a list of cs without lbt.
- ;; Do we need -lbt?
- (dolist (c (mm-get-coding-system-list))
- (if (and (null cs)
- (eq charset (or (coding-system-get c :mime-charset)
- (coding-system-get c 'mime-charset))))
- (setq cs c)))
- cs))))
-
(eval-and-compile
- (defvar mm-emacs-mule (and (not (featurep 'xemacs))
- (boundp 'default-enable-multibyte-characters)
- default-enable-multibyte-characters
- (fboundp 'set-buffer-multibyte))
- "True in Emacs with Mule.")
-
- (if mm-emacs-mule
- (defun mm-enable-multibyte ()
- "Set the multibyte flag of the current buffer.
+ (if (featurep 'xemacs)
+ (defalias 'mm-enable-multibyte 'ignore)
+ (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 'to))
- (defalias 'mm-enable-multibyte 'ignore))
+ (set-buffer-multibyte t)))
- (if mm-emacs-mule
- (defun mm-disable-multibyte ()
- "Unset the multibyte flag of in the current buffer.
+ (if (featurep 'xemacs)
+ (defalias 'mm-disable-multibyte 'ignore)
+ (defun mm-disable-multibyte ()
+ "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)))
+ (set-buffer-multibyte nil))))
(defun mm-preferred-coding-system (charset)
;; A typo in some Emacs versions.
;; 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)))
+(if (fboundp 'delete-dups)
+ (defalias 'mm-delete-duplicates 'delete-dups)
+ (defun mm-delete-duplicates (list)
+ "Destructively remove `equal' duplicates from LIST.
+Store the result in LIST and return it. LIST must be a proper list.
+Of several `equal' occurrences of an element in LIST, the first
+one is kept.
+
+This is a compatibility function for Emacsen without `delete-dups'."
+ ;; Code from `subr.el' in Emacs 22:
+ (let ((tail list))
+ (while tail
+ (setcdr tail (delete (car tail) (cdr tail)))
+ (setq tail (cdr tail))))
+ list))
;; Fixme: This is used in places when it should be testing the
;; default multibyteness. See 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
+ (if (boundp 'enable-multibyte-characters)
+ (default-value 'enable-multibyte-characters)
t)))
(defun mm-iso-8859-x-to-15-region (&optional b e)
(autoload 'latin-unity-massage-name "latin-unity")
(autoload 'latin-unity-maybe-remap "latin-unity")
(autoload 'latin-unity-representations-feasible-region "latin-unity")
- (autoload 'latin-unity-representations-present-region "latin-unity")
- (defvar latin-unity-coding-systems)
- (defvar latin-unity-ucs-list))
+ (autoload 'latin-unity-representations-present-region "latin-unity"))
+
+(defvar latin-unity-coding-systems)
+(defvar latin-unity-ucs-list)
(defun mm-xemacs-find-mime-charset-1 (begin end)
"Determine which MIME charset to use to send region as message.
(when (featurep 'xemacs)
`(and (featurep 'mule) (mm-xemacs-find-mime-charset-1 ,begin ,end))))
+(declare-function mm-delete-duplicates "mm-util" (list))
+
(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
;; Otherwise, we'll get nil, and the next setq will get invoked.
(setq charsets (mm-xemacs-find-mime-charset b e))
+ ;; Fixme: won't work for unibyte Emacs 23:
+
;; We're not multibyte, or a single coding system won't cover it.
(setq charsets
(mm-delete-duplicates
(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))
+ (dolist (x mm-iso-8859-15-compatible)
+ (setq charsets (delq (car x) charsets))))
(if (and (memq 'iso-2022-jp-2 charsets)
(memq 'iso-2022-jp-2 hack-charsets))
(setq charsets (delq 'iso-2022-jp charsets)))
+ ;; Attempt to reduce the number of charsets if utf-8 is available.
+ (if (and (featurep 'xemacs)
+ (> (length charsets) 1)
+ (mm-coding-system-p 'utf-8))
+ (let ((mm-coding-system-priorities
+ (cons 'utf-8 mm-coding-system-priorities)))
+ (setq charsets
+ (mm-delete-duplicates
+ (mapcar 'mm-mime-charset
+ (delq 'ascii
+ (mm-find-charset-region b e)))))))
charsets))
(defmacro mm-with-unibyte-buffer (&rest forms)
"Create a temporary buffer, and evaluate FORMS there like `progn'.
Use unibyte mode for this."
- `(let (default-enable-multibyte-characters)
- (with-temp-buffer ,@forms)))
+ `(with-temp-buffer
+ (mm-disable-multibyte)
+ ,@forms))
(put 'mm-with-unibyte-buffer 'lisp-indent-function 0)
(put 'mm-with-unibyte-buffer 'edebug-form-spec '(body))
(defmacro mm-with-multibyte-buffer (&rest forms)
"Create a temporary buffer, and evaluate FORMS there like `progn'.
Use multibyte mode for this."
- `(let ((default-enable-multibyte-characters t))
- (with-temp-buffer ,@forms)))
+ `(with-temp-buffer
+ (mm-enable-multibyte)
+ ,@forms))
(put 'mm-with-multibyte-buffer 'lisp-indent-function 0)
(put 'mm-with-multibyte-buffer 'edebug-form-spec '(body))
(defmacro mm-with-unibyte-current-buffer (&rest forms)
"Evaluate FORMS with current buffer temporarily made unibyte.
-Also bind `default-enable-multibyte-characters' to nil.
-Equivalent to `progn' in XEmacs"
- (let ((multibyte (make-symbol "multibyte"))
- (buffer (make-symbol "buffer")))
- `(if mm-emacs-mule
- (let ((,multibyte enable-multibyte-characters)
- (,buffer (current-buffer)))
- (unwind-protect
- (let (default-enable-multibyte-characters)
- (set-buffer-multibyte nil)
- ,@forms)
- (set-buffer ,buffer)
- (set-buffer-multibyte ,multibyte)))
- (let (default-enable-multibyte-characters)
- ,@forms))))
+Equivalent to `progn' in XEmacs.
+
+Note: We recommend not using this macro any more; there should be
+better ways to do a similar thing. The previous version of this macro
+bound the default value of `enable-multibyte-characters' to nil while
+evaluating FORMS but it is no longer done. So, some programs assuming
+it if any may malfunction."
+ (if (featurep 'xemacs)
+ `(progn ,@forms)
+ (let ((multibyte (make-symbol "multibyte")))
+ `(let ((,multibyte enable-multibyte-characters))
+ (when ,multibyte
+ (set-buffer-multibyte nil))
+ (prog1
+ (progn ,@forms)
+ (when ,multibyte
+ (set-buffer-multibyte t)))))))
(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)
- "Eval the FORMS with the default value of `enable-multibyte-characters' nil."
- `(let (default-enable-multibyte-characters)
- ,@forms))
-(put 'mm-with-unibyte 'lisp-indent-function 0)
-(put 'mm-with-unibyte 'edebug-form-spec '(body))
-
-(defmacro mm-with-multibyte (&rest forms)
- "Eval the FORMS with the default value of `enable-multibyte-characters' t."
- `(let ((default-enable-multibyte-characters t))
- ,@forms))
-(put 'mm-with-multibyte 'lisp-indent-function 0)
-(put 'mm-with-multibyte 'edebug-form-spec '(body))
-
(defun mm-find-charset-region (b e)
"Return a list of Emacs charsets in the region B to E."
(cond
;; Remove composition since the base charsets have been included.
;; Remove eight-bit-*, treat them as ascii.
(let ((css (find-charset-region b e)))
- (mapcar (lambda (cs) (setq css (delq cs css)))
- '(composition eight-bit-control eight-bit-graphic
- control-1))
- css))
+ (dolist (cs
+ '(composition eight-bit-control eight-bit-graphic control-1)
+ css)
+ (setq css (delq cs css)))))
(t
;; We are in a unibyte buffer or XEmacs non-mule, so we futz around a bit.
(save-excursion
(nreverse out)))
(defvar mm-inhibit-file-name-handlers
- '(jka-compr-handler image-file-handler)
+ '(jka-compr-handler image-file-handler epa-file-handler)
"A list of handlers doing (un)compression (etc) thingies.")
(defun mm-insert-file-contents (filename &optional visit beg end replace
`find-file-hooks', etc.
If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'.
This function ensures that none of these modifications will take place."
- (let* ((format-alist nil)
- (auto-mode-alist (if inhibit nil (mm-auto-mode-alist)))
- (default-major-mode 'fundamental-mode)
- (enable-local-variables nil)
- (after-insert-file-functions nil)
- (enable-local-eval nil)
- (inhibit-file-name-operation (if inhibit
- 'insert-file-contents
- inhibit-file-name-operation))
- (inhibit-file-name-handlers
- (if inhibit
- (append mm-inhibit-file-name-handlers
- inhibit-file-name-handlers)
- inhibit-file-name-handlers))
- (ffh (if (boundp 'find-file-hook)
- 'find-file-hook
- 'find-file-hooks))
- (val (symbol-value ffh)))
+ (letf* ((format-alist nil)
+ (auto-mode-alist (if inhibit nil (mm-auto-mode-alist)))
+ ((default-value 'major-mode) 'fundamental-mode)
+ (enable-local-variables nil)
+ (after-insert-file-functions nil)
+ (enable-local-eval nil)
+ (inhibit-file-name-operation (if inhibit
+ 'insert-file-contents
+ inhibit-file-name-operation))
+ (inhibit-file-name-handlers
+ (if inhibit
+ (append mm-inhibit-file-name-handlers
+ inhibit-file-name-handlers)
+ inhibit-file-name-handlers))
+ (ffh (if (boundp 'find-file-hook)
+ 'find-file-hook
+ 'find-file-hooks))
+ (val (symbol-value ffh)))
(set ffh nil)
(unwind-protect
(insert-file-contents filename visit beg end replace)
inhibit-file-name-handlers)))
(write-region start end filename append visit lockname)))
+(autoload 'gmm-write-region "gmm-utils")
+
+;; It is not a MIME function, but some MIME functions use it.
+(if (and (fboundp 'make-temp-file)
+ (ignore-errors
+ (let ((def (symbol-function 'make-temp-file)))
+ (and (byte-code-function-p def)
+ (setq def (if (fboundp 'compiled-function-arglist)
+ ;; XEmacs
+ (eval (list 'compiled-function-arglist def))
+ (aref def 0)))
+ (>= (length def) 4)
+ (eq (nth 3 def) 'suffix)))))
+ (defalias 'mm-make-temp-file 'make-temp-file)
+ ;; Stolen (and modified for XEmacs) from Emacs 22.
+ (defun mm-make-temp-file (prefix &optional dir-flag suffix)
+ "Create a temporary file.
+The returned file name (created by appending some random characters at the end
+of PREFIX, and expanding against `temporary-file-directory' if necessary),
+is guaranteed to point to a newly created empty file.
+You can then use `write-region' to write new data into the file.
+
+If DIR-FLAG is non-nil, create a new empty directory instead of a file.
+
+If SUFFIX is non-nil, add that at the end of the file name."
+ (let ((umask (default-file-modes))
+ file)
+ (unwind-protect
+ (progn
+ ;; Create temp files with strict access rights. It's easy to
+ ;; loosen them later, whereas it's impossible to close the
+ ;; time-window of loose permissions otherwise.
+ (set-default-file-modes 448)
+ (while (condition-case err
+ (progn
+ (setq file
+ (make-temp-name
+ (expand-file-name
+ prefix
+ (if (fboundp 'temp-directory)
+ ;; XEmacs
+ (temp-directory)
+ temporary-file-directory))))
+ (if suffix
+ (setq file (concat file suffix)))
+ (if dir-flag
+ (make-directory file)
+ ;; NOTE: This is unsafe if Emacs 20
+ ;; users and XEmacs users don't use
+ ;; a secure temp directory.
+ (gmm-write-region "" nil file nil 'silent
+ nil 'excl))
+ nil)
+ (file-already-exists t)
+ ;; The XEmacs version of `make-directory' issues
+ ;; `file-error'.
+ (file-error (or (and (featurep 'xemacs)
+ (file-exists-p file))
+ (signal (car err) (cdr err)))))
+ ;; the file was somehow created by someone else between
+ ;; `make-temp-name' and `write-region', let's try again.
+ nil)
+ file)
+ ;; Reset the umask.
+ (set-default-file-modes umask)))))
+
(defun mm-image-load-path (&optional package)
(let (dir result)
(dolist (path load-path (nreverse result))
(if (eq (point) end) 'ascii (mm-guess-charset))
(goto-char point)))))
+(declare-function mm-detect-coding-region "mm-util" (start end))
+
(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."
(coding-system-for-write mm-binary-coding-system)
retval err-msg)
(message "%s" msg)
- (with-temp-buffer
+ (mm-with-unibyte-buffer
(insert-buffer-substring cur)
(condition-case err
(progn
(error
(setq err-msg (error-message-string err)))))
(when (file-exists-p err-file)
- (ignore-errors (jka-compr-delete-temp-file err-file)))
+ (ignore-errors (delete-file err-file)))
(when inplace
(unless err-msg
(delete-region (point-min) (point-max))
filename))
(mm-decompress-buffer filename nil t))))
(when decomp
- (set-buffer (let (default-enable-multibyte-characters)
- (generate-new-buffer " *temp*")))
+ (set-buffer (generate-new-buffer " *temp*"))
+ (mm-disable-multibyte)
(insert decomp)
(setq filename (file-name-sans-extension filename)))
(goto-char (point-min))
(funcall (symbol-value 'set-auto-coding-function)
nil (- (point-max) (point-min)))
(error nil)))))
- ((featurep 'file-coding) ;; XEmacs
+ ((and (featurep 'xemacs) (featurep 'file-coding)) ;; XEmacs
(let ((case-fold-search t)
(end (point-at-eol))
codesys start)