+(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)))
+(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))))
+(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
+ ((and (mm-multibyte-p)
+ (fboundp 'find-charset-region))
+ ;; 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))
+ (t
+ ;; We are in a unibyte buffer or XEmacs non-mule, so we futz around a bit.
+ (save-excursion
+ (save-restriction
+ (narrow-to-region b e)
+ (goto-char (point-min))
+ (skip-chars-forward "\0-\177")
+ (if (eobp)
+ '(ascii)
+ (let (charset)
+ (setq charset
+ (and (boundp 'current-language-environment)
+ (car (last (assq 'charset
+ (assoc current-language-environment
+ language-info-alist))))))
+ (if (eq charset 'ascii) (setq charset nil))
+ (or charset
+ (setq charset
+ (car (last (assq mail-parse-charset
+ mm-mime-mule-charset-alist)))))
+ (list 'ascii (or charset 'latin-iso8859-1)))))))))
+
+(defun mm-auto-mode-alist ()
+ "Return an `auto-mode-alist' with only the .gz (etc) thingies."
+ (let ((alist auto-mode-alist)
+ out)
+ (while alist
+ (when (listp (cdar alist))
+ (push (car alist) out))
+ (pop alist))
+ (nreverse out)))
+
+(defvar mm-inhibit-file-name-handlers
+ '(jka-compr-handler image-file-handler)
+ "A list of handlers doing (un)compression (etc) thingies.")
+
+(defun mm-insert-file-contents (filename &optional visit beg end replace
+ inhibit)
+ "Like `insert-file-contents', but only reads in the file.
+A buffer may be modified in several ways after reading into the buffer due
+to advanced Emacs features, such as file-name-handlers, format decoding,
+`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)))
+ (set ffh nil)
+ (unwind-protect
+ (insert-file-contents filename visit beg end replace)
+ (set ffh val))))
+
+(defun mm-append-to-file (start end filename &optional codesys inhibit)
+ "Append the contents of the region to the end of file FILENAME.
+When called from a function, expects three arguments,
+START, END and FILENAME. START and END are buffer positions
+saying what text to write.
+Optional fourth argument specifies the coding system to use when
+encoding the file.
+If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'."
+ (let ((coding-system-for-write
+ (or codesys mm-text-coding-system-for-write
+ mm-text-coding-system))
+ (inhibit-file-name-operation (if inhibit
+ 'append-to-file
+ inhibit-file-name-operation))
+ (inhibit-file-name-handlers
+ (if inhibit
+ (append mm-inhibit-file-name-handlers
+ inhibit-file-name-handlers)
+ inhibit-file-name-handlers)))
+ (write-region start end filename t 'no-message)
+ (message "Appended to %s" filename)))
+
+(defun mm-write-region (start end filename &optional append visit lockname
+ coding-system inhibit)
+
+ "Like `write-region'.
+If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'."
+ (let ((coding-system-for-write
+ (or coding-system mm-text-coding-system-for-write
+ mm-text-coding-system))
+ (inhibit-file-name-operation (if inhibit
+ 'write-region
+ inhibit-file-name-operation))
+ (inhibit-file-name-handlers
+ (if inhibit
+ (append mm-inhibit-file-name-handlers
+ inhibit-file-name-handlers)
+ 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))
+ (when (and path
+ (file-directory-p
+ (setq dir (concat (file-name-directory
+ (directory-file-name path))
+ "etc/images/" (or package "gnus/")))))
+ (push dir result))
+ (push path result))))
+
+;; Fixme: This doesn't look useful where it's used.
+(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 start end)))
+ (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)))
+ (or (coding-system-get cs :mime-charset)
+ (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)))
+
+(eval-when-compile
+ (unless (fboundp 'coding-system-to-mime-charset)
+ (defalias 'coding-system-to-mime-charset 'ignore)))
+
+(defun mm-coding-system-to-mime-charset (coding-system)
+ "Return the MIME charset corresponding to CODING-SYSTEM.
+To make this function work with XEmacs, the APEL package is required."
+ (when coding-system
+ (or (and (fboundp 'coding-system-get)
+ (or (coding-system-get coding-system :mime-charset)
+ (coding-system-get coding-system 'mime-charset)))
+ (and (featurep 'xemacs)
+ (or (and (fboundp 'coding-system-to-mime-charset)
+ (not (eq (symbol-function 'coding-system-to-mime-charset)
+ 'ignore)))
+ (and (condition-case nil
+ (require 'mcharset)
+ (error nil))
+ (fboundp 'coding-system-to-mime-charset)))
+ (coding-system-to-mime-charset coding-system)))))
+
+(eval-when-compile
+ (require 'jka-compr))
+
+(defun mm-decompress-buffer (filename &optional inplace force)
+ "Decompress buffer's contents, depending on jka-compr.
+Only when FORCE is t or `auto-compression-mode' is enabled and FILENAME
+agrees with `jka-compr-compression-info-list', decompression is done.
+Signal an error if FORCE is neither nil nor t and compressed data are
+not decompressed because `auto-compression-mode' is disabled.
+If INPLACE is nil, return decompressed data or nil without modifying
+the buffer. Otherwise, replace the buffer's contents with the
+decompressed data. The buffer's multibyteness must be turned off."
+ (when (and filename
+ (if force
+ (prog1 t (require 'jka-compr))
+ (and (fboundp 'jka-compr-installed-p)
+ (jka-compr-installed-p))))
+ (let ((info (jka-compr-get-compression-info filename)))
+ (when info
+ (unless (or (memq force (list nil t))
+ (jka-compr-installed-p))
+ (error ""))
+ (let ((prog (jka-compr-info-uncompress-program info))
+ (args (jka-compr-info-uncompress-args info))
+ (msg (format "%s %s..."
+ (jka-compr-info-uncompress-message info)
+ filename))
+ (err-file (jka-compr-make-temp-name))
+ (cur (current-buffer))
+ (coding-system-for-read mm-binary-coding-system)
+ (coding-system-for-write mm-binary-coding-system)
+ retval err-msg)
+ (message "%s" msg)
+ (with-temp-buffer
+ (insert-buffer-substring cur)
+ (condition-case err
+ (progn
+ (unless (memq (apply 'call-process-region
+ (point-min) (point-max)
+ prog t (list t err-file) nil args)
+ jka-compr-acceptable-retval-list)
+ (erase-buffer)
+ (insert (mapconcat
+ 'identity
+ (delete "" (split-string
+ (prog2
+ (insert-file-contents err-file)
+ (buffer-string)
+ (erase-buffer))))
+ " ")
+ "\n")
+ (setq err-msg
+ (format "Error while executing \"%s %s < %s\""
+ prog (mapconcat 'identity args " ")
+ filename)))
+ (setq retval (buffer-string)))
+ (error
+ (setq err-msg (error-message-string err)))))
+ (when (file-exists-p err-file)
+ (ignore-errors (jka-compr-delete-temp-file err-file)))
+ (when inplace
+ (unless err-msg
+ (delete-region (point-min) (point-max))
+ (insert retval))
+ (setq retval nil))
+ (message "%s" (or err-msg (concat msg "done")))
+ retval)))))
+
+(eval-when-compile
+ (unless (fboundp 'coding-system-name)
+ (defalias 'coding-system-name 'ignore))
+ (unless (fboundp 'find-file-coding-system-for-read-from-filename)
+ (defalias 'find-file-coding-system-for-read-from-filename 'ignore))
+ (unless (fboundp 'find-operation-coding-system)
+ (defalias 'find-operation-coding-system 'ignore)))
+
+(defun mm-find-buffer-file-coding-system (&optional filename)
+ "Find coding system used to decode the contents of the current buffer.
+This function looks for the coding system magic cookie or examines the
+coding system specified by `file-coding-system-alist' being associated
+with FILENAME which defaults to `buffer-file-name'. Data compressed by
+gzip, bzip2, etc. are allowed."
+ (unless filename
+ (setq filename buffer-file-name))
+ (save-excursion
+ (let ((decomp (unless ;; No worth to examine charset of tar files.
+ (and filename
+ (string-match
+ "\\.\\(?:tar\\.[^.]+\\|tbz\\|tgz\\)\\'"
+ filename))
+ (mm-decompress-buffer filename nil t))))
+ (when decomp
+ (set-buffer (let (default-enable-multibyte-characters)
+ (generate-new-buffer " *temp*")))
+ (insert decomp)
+ (setq filename (file-name-sans-extension filename)))
+ (goto-char (point-min))
+ (prog1
+ (cond
+ ((boundp 'set-auto-coding-function) ;; Emacs
+ (if filename
+ (or (funcall (symbol-value 'set-auto-coding-function)
+ filename (- (point-max) (point-min)))
+ (car (find-operation-coding-system 'insert-file-contents
+ filename)))
+ (let (auto-coding-alist)
+ (condition-case nil
+ (funcall (symbol-value 'set-auto-coding-function)
+ nil (- (point-max) (point-min)))
+ (error nil)))))
+ ((featurep 'file-coding) ;; XEmacs
+ (let ((case-fold-search t)
+ (end (point-at-eol))
+ codesys start)
+ (or
+ (and (re-search-forward "-\\*-+[\t ]*" end t)
+ (progn
+ (setq start (match-end 0))
+ (re-search-forward "[\t ]*-+\\*-" end t))
+ (progn
+ (setq end (match-beginning 0))
+ (goto-char start)
+ (or (looking-at "coding:[\t ]*\\([^\t ;]+\\)")
+ (re-search-forward
+ "[\t ;]+coding:[\t ]*\\([^\t ;]+\\)"
+ end t)))
+ (find-coding-system (setq codesys
+ (intern (match-string 1))))
+ codesys)
+ (and (re-search-forward "^[\t ]*;+[\t ]*Local[\t ]+Variables:"
+ nil t)
+ (progn
+ (setq start (match-end 0))
+ (re-search-forward "^[\t ]*;+[\t ]*End:" nil t))
+ (progn
+ (setq end (match-beginning 0))
+ (goto-char start)
+ (re-search-forward
+ "^[\t ]*;+[\t ]*coding:[\t ]*\\([^\t\n\r ]+\\)"
+ end t))
+ (find-coding-system (setq codesys
+ (intern (match-string 1))))
+ codesys)
+ (and (progn
+ (goto-char (point-min))
+ (setq case-fold-search nil)
+ (re-search-forward "^;;;coding system: "
+ ;;(+ (point-min) 3000) t))
+ nil t))
+ (looking-at "[^\t\n\r ]+")
+ (find-coding-system
+ (setq codesys (intern (match-string 0))))
+ codesys)
+ (and filename
+ (setq codesys
+ (find-file-coding-system-for-read-from-filename
+ filename))
+ (coding-system-name (coding-system-base codesys)))))))
+ (when decomp
+ (kill-buffer (current-buffer)))))))