* Makefile.in (install-package-ja): Compile and install lisp files first.
[elisp/gnus.git-] / lisp / mm-util.el
index 31f5938..096d0f4 100644 (file)
@@ -26,6 +26,7 @@
 
 (eval-when-compile (require 'static))
 
+(eval-when-compile (require 'cl))
 (require 'mail-prsvr)
 
 (defvar mm-mime-mule-charset-alist
@@ -229,6 +230,22 @@ used as the line break code type of the coding system."
   (when (fboundp 'set-buffer-multibyte)
     (set-buffer-multibyte nil)))
 
+(defsubst mm-enable-multibyte-mule4 ()
+  "Enable multibyte in the current buffer.
+Only used in Emacs Mule 4."
+  (when (and (fboundp 'set-buffer-multibyte)
+             (boundp 'enable-multibyte-characters)
+            (default-value 'enable-multibyte-characters)
+            (not (charsetp 'eight-bit-control)))
+    (set-buffer-multibyte t)))
+
+(defsubst mm-disable-multibyte-mule4 ()
+  "Disable multibyte in the current buffer.
+Only used in Emacs Mule 4."
+  (when (and (fboundp 'set-buffer-multibyte)
+            (not (charsetp 'eight-bit-control)))
+    (set-buffer-multibyte nil)))
+
 (defun mm-preferred-coding-system (charset)
   ;; A typo in some Emacs versions.
   (or (get-charset-property charset 'prefered-coding-system)
@@ -239,30 +256,33 @@ used as the line break code type of the coding system."
 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 (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))))
-      charset)))
+  (let ((char (char-after pos)) charset)
+    (if (< (mm-char-int char) 128)
+       (setq charset 'ascii)
+      ;; charset-after is fake in some Emacsen.
+      (setq charset (and (fboundp 'char-charset) (char-charset char)))
+      (if (eq charset 'composition)
+         (let ((p (or pos (point))))
+           (cadr (find-charset-region p (1+ p))))
+       (if (and charset (not (memq charset '(ascii eight-bit-control
+                                                   eight-bit-graphic))))
+           charset
+         (or
+          mail-parse-mule-charset ;; cached mule-charset
+          (progn
+            (setq mail-parse-mule-charset
+                  (and (boundp 'current-language-environment)
+                     (car (last 
+                           (assq 'charset 
+                                 (assoc current-language-environment 
+                                        language-info-alist))))))
+            (if (or (not mail-parse-mule-charset)
+                    (eq mail-parse-mule-charset 'ascii))
+                (setq mail-parse-mule-charset
+                      (or (car (last (assq mail-parse-charset
+                                           mm-mime-mule-charset-alist)))
+                          'latin-iso8859-1)))
+            mail-parse-mule-charset)))))))
 
 (defun mm-mime-charset (charset)
   "Return the MIME charset corresponding to the MULE CHARSET."
@@ -304,9 +324,10 @@ If the charset is `composition', return the actual one."
 
 (defsubst mm-multibyte-p ()
   "Say whether multibyte is enabled."
-  (or (featurep 'xemacs)
-      (and (boundp 'enable-multibyte-characters)
-          enable-multibyte-characters)))
+  (if (and (not (featurep 'xemacs))
+          (boundp 'enable-multibyte-characters))
+      enable-multibyte-characters
+    (featurep 'mule)))
 
 (defmacro mm-with-unibyte-buffer (&rest forms)
   "Create a temporary buffer, and evaluate FORMS there like `progn'.
@@ -355,6 +376,28 @@ See also `with-temp-file' and `with-output-to-string'."
 (put 'mm-with-unibyte-current-buffer 'lisp-indent-function 0)
 (put 'mm-with-unibyte-current-buffer 'edebug-form-spec '(body))
 
+(defmacro mm-with-unibyte-current-buffer-mule4 (&rest forms)
+  "Evaluate FORMS there like `progn' in current buffer.
+Mule4 only."
+  (let ((multibyte (make-symbol "multibyte")))
+    `(if (or (featurep 'xemacs)
+            (not (fboundp 'set-buffer-multibyte))
+            (charsetp 'eight-bit-control)) ;; For Emacs Mule 4 only.
+        (progn
+          ,@forms)
+       (let ((,multibyte (default-value 'enable-multibyte-characters)))
+        (unwind-protect
+            (let ((buffer-file-coding-system mm-binary-coding-system)
+                  (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-mule4 'lisp-indent-function 0)
+(put 'mm-with-unibyte-current-buffer-mule4 '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")))
@@ -377,7 +420,8 @@ See also `with-temp-file' and `with-output-to-string'."
         (fboundp 'find-charset-region))
     ;; Remove composition since the base charsets have been included.
     (delq 'composition (find-charset-region b e)))
-   ((not (boundp 'current-language-environment))
+   (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)
@@ -385,24 +429,18 @@ See also `with-temp-file' and `with-output-to-string'."
        (skip-chars-forward "\0-\177")
        (if (eobp)
            '(ascii)
-         (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
-      (save-restriction
-       (narrow-to-region b e)
-       (goto-char (point-min))
-       (let ((entry (assoc current-language-environment 
-                           language-info-alist)))
-         (skip-chars-forward "\0-\177")
-         (if (eobp)
-             '(ascii)
-           (delq nil (list 'ascii 
-                           (or (car (last (assq 'charset entry)))
-                               'latin-iso8859-1))))))))))
+         (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)))))))))
 
 (static-if (fboundp 'shell-quote-argument)
     (defalias 'mm-quote-arg 'shell-quote-argument)