X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fmm-util.el;h=802ad8688de24b01ecf46e96f6060bb5c2151db0;hb=0ddd674342067ef66a296cab65fa509f605aa9d0;hp=87653b7dadc77182dc86efdfe21da3275b38f121;hpb=9469da9f647529e1077d04eacccbf75cc49f9f72;p=gnus diff --git a/lisp/mm-util.el b/lisp/mm-util.el index 87653b7da..802ad8688 100644 --- a/lisp/mm-util.el +++ b/lisp/mm-util.el @@ -1,7 +1,7 @@ ;;; 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 ;; MORIOKA Tomohiko @@ -100,18 +100,23 @@ (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 @@ -159,7 +164,7 @@ system object in XEmacs." (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) @@ -224,7 +229,7 @@ the alias. Else windows-NUMBER is used." `((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 @@ -392,7 +397,7 @@ with Mule charsets. It is completely useless for Emacs." 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 @@ -888,11 +893,18 @@ Use multibyte mode for this." (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) @@ -1038,6 +1050,74 @@ If INHIBIT is non-nil, inhibit `mm-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))