;;; 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.
+;; 2005, 2006 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
(eval-when-compile (require 'cl))
(require 'mail-prsvr)
+(eval-and-compile
+ (if (featurep 'xemacs)
+ (unless (ignore-errors
+ (require 'timer-funcs))
+ (require 'timer))
+ (require 'timer)))
+
(eval-and-compile
(mapcar
(lambda (elem)
(lambda (ch) (mm-string-as-multibyte (char-to-string ch)))
string "")))
(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))))
+ (multibyte-char-to-unibyte . identity)
+ (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))))))))))))
(eval-and-compile
(defalias 'mm-char-or-char-int-p
(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)
(unless (mm-coding-system-p cp)
(codepage-setup number))
(when (and alias
- (mm-coding-system-p 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)))))
`((iso-8859-1 . windows-1252))
"A mapping from undesired charset names to their replacement.
-You may add pair like (iso-8859-1 . windows-1252) here,
+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 (set :inline t
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
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."
- ;; OVERRIDE is used (only) in `mm-decode-body'.
+ ;; OVERRIDE is used (only) in `mm-decode-body' and `mm-decode-string'.
(when (stringp charset)
(setq charset (intern (downcase charset))))
(when lbt
(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"
+Equivalent to `progn' in XEmacs
+
+NOTE: Use this macro with caution in multibyte buffers (it is not
+worth using this macro in unibyte buffers of course). Use of
+`(set-buffer-multibyte t)', which is run finally, is generally
+harmful since it is likely to modify existing data in the buffer.
+For instance, it converts \"\\300\\255\" into \"\\255\" in
+Emacs 23 (unicode)."
(let ((multibyte (make-symbol "multibyte"))
(buffer (make-symbol "buffer")))
`(if mm-emacs-mule
- (let ((,multibyte enable-multibyte-characters)
+ (let ((,multibyte enable-multibyte-characters)
(,buffer (current-buffer)))
(unwind-protect
(let (default-enable-multibyte-characters)
inhibit-file-name-handlers)))
(write-region start end filename append visit lockname)))
+;; 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)
+ (if (featurep 'xemacs)
+ ;; NOTE: This is unsafe if XEmacs users
+ ;; don't use a secure temp directory.
+ (if (file-exists-p file)
+ (signal 'file-already-exists
+ (list "File exists" file))
+ (write-region "" nil file nil 'silent))
+ (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))
(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