comparison lisp/gnus/mm-util.el @ 32976:aa9dc4e7c5ac

2000-10-27 ShengHuo ZHU <[e-mail]> * mm-util.el (mm-multibyte-p): Test (featurep 'xemacs). (mm-with-unibyte-current-buffer-mule4): New function. (mm-enable-multibyte-mule4): New. (mm-disable-multibyte-mule4): New. * mm-util.el (mm-enable-multibyte-mule4): New. (mm-disable-multibyte-mule4): New.

32975:5155c0078eb9

;;; mm-util.el --- Utility functions for MIME things
;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.

;; Author: Lars Magne Ingebrigtsen <[e-mail]>
;;	MORIOKA Tomohiko <[e-mail]>
;; This file is part of GNU Emacs.

;; 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)

;;; Commentary:

;;; Code:

(require 'mail-prsvr)

(defvar mm-mime-mule-charset-alist
  '((us-ascii ascii)
    (iso-8859-1 latin-iso8859-1)

    (koi8-r cyrillic-iso8859-5 gnus-koi8-r)
    (iso-8859-6 arabic-iso8859-6)
    (iso-8859-7 greek-iso8859-7)
    (iso-8859-8 hebrew-iso8859-8)
    (iso-8859-9 latin-iso8859-9)
    (iso-8859-14 latin-iso8859-14)
    (iso-8859-15 latin-iso8859-15)
    (viscii vietnamese-viscii-lower)
    (iso-2022-jp latin-jisx0201 japanese-jisx0208 japanese-jisx0208-1978)
    (euc-kr korean-ksc5601)
    (cn-gb-2312 chinese-gb2312)
    (cn-big5 chinese-big5-1 chinese-big5-2)

(defsubst mm-disable-multibyte ()
  "Disable multibyte in the current buffer."
  (when (fboundp 'set-buffer-multibyte)
    (set-buffer-multibyte nil)))

(defun mm-preferred-coding-system (charset)
  ;; A typo in some Emacs versions.
  (or (get-charset-property charset 'prefered-coding-system)
      (get-charset-property charset 'preferred-coding-system)))

(defun mm-charset-after (&optional pos)
  "Return charset of a character in current buffer at position POS.
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)))

(defun mm-mime-charset (charset)
  "Return the MIME charset corresponding to the MULE CHARSET."
  (if (and (fboundp 'coding-system-get)
	   (fboundp 'get-charset-property))
      ;; This exists in Emacs 20.
      (or
       (and (mm-preferred-coding-system charset)
	    (coding-system-get
	     (mm-preferred-coding-system charset) 'mime-charset))

	'(utf-8)
      charsets)))

(defsubst mm-multibyte-p ()
  "Say whether multibyte is enabled."
  (or (featurep 'xemacs)
      (and (boundp 'enable-multibyte-characters)
	   enable-multibyte-characters)))

(defmacro mm-with-unibyte-buffer (&rest forms)
  "Create a temporary buffer, and evaluate FORMS there like `progn'.
See also `with-temp-file' and `with-output-to-string'."
  (let ((temp-buffer (make-symbol "temp-buffer"))
	(multibyte (make-symbol "multibyte")))
    `(if (or (string-match "XEmacs\\|Lucid" emacs-version)
	     (not (boundp 'enable-multibyte-characters)))
	 (with-temp-buffer ,@forms)
       (let ((,multibyte (default-value 'enable-multibyte-characters))
	     ,temp-buffer)
	 (unwind-protect

	   (setq-default enable-multibyte-characters ,multibyte)
	   (set-buffer-multibyte ,multibyte))))))
(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)
  "Set default `enable-multibyte-characters' to `nil', eval the FORMS."
  (let ((multibyte (make-symbol "multibyte")))
    `(if (or (featurep 'xemacs)
	     (not (boundp 'enable-multibyte-characters)))

  (cond
   ((and (mm-multibyte-p)
 	 (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))
    (save-excursion
      (save-restriction
	(narrow-to-region b e)
	(goto-char (point-min))
	(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))))))))))

(if (fboundp 'shell-quote-argument)
    (defalias 'mm-quote-arg 'shell-quote-argument)
  (defun mm-quote-arg (arg)
    "Return a version of ARG that is safe to evaluate in a shell."

32976:aa9dc4e7c5ac

;;; mm-util.el --- Utility functions for MIME things
;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.

;; Author: Lars Magne Ingebrigtsen <[e-mail]>
;;	MORIOKA Tomohiko <[e-mail]>
;; Maintainer: [e-mail]
;; This file is part of GNU Emacs.

;; 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)

;;; Commentary:

;;; Code:

(eval-when-compile (require 'cl))
(require 'mail-prsvr)

(defvar mm-mime-mule-charset-alist
  '((us-ascii ascii)
    (iso-8859-1 latin-iso8859-1)

    (koi8-r cyrillic-iso8859-5 gnus-koi8-r)
    (iso-8859-6 arabic-iso8859-6)
    (iso-8859-7 greek-iso8859-7)
    (iso-8859-8 hebrew-iso8859-8)
    (iso-8859-9 latin-iso8859-9)
    (viscii vietnamese-viscii-lower)
    (iso-2022-jp latin-jisx0201 japanese-jisx0208 japanese-jisx0208-1978)
    (euc-kr korean-ksc5601)
    (cn-gb-2312 chinese-gb2312)
    (cn-big5 chinese-big5-1 chinese-big5-2)

(defsubst mm-disable-multibyte ()
  "Disable multibyte in the current buffer."
  (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)
      (get-charset-property charset 'preferred-coding-system)))

(defun mm-charset-after (&optional pos)
  "Return charset of a character in current buffer at position POS.
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 ((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."
  (if (and (fboundp 'coding-system-get) (fboundp 'get-charset-property))
      ;; This exists in Emacs 20.
      (or
       (and (mm-preferred-coding-system charset)
	    (coding-system-get
	     (mm-preferred-coding-system charset) 'mime-charset))

	'(utf-8)
      charsets)))

(defsubst mm-multibyte-p ()
  "Say whether multibyte is enabled."
  (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'.
See also `with-temp-file' and `with-output-to-string'."
  (let ((temp-buffer (make-symbol "temp-buffer"))
	(multibyte (make-symbol "multibyte")))
    `(if (or (featurep 'xemacs)
	     (not (boundp 'enable-multibyte-characters)))
	 (with-temp-buffer ,@forms)
       (let ((,multibyte (default-value 'enable-multibyte-characters))
	     ,temp-buffer)
	 (unwind-protect

	   (setq-default enable-multibyte-characters ,multibyte)
	   (set-buffer-multibyte ,multibyte))))))
(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")))
    `(if (or (featurep 'xemacs)
	     (not (boundp 'enable-multibyte-characters)))

  (cond
   ((and (mm-multibyte-p)
 	 (fboundp 'find-charset-region))
    ;; Remove composition since the base charsets have been included.
    (delq 'composition (find-charset-region b e)))
   (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)))))))))

(if (fboundp 'shell-quote-argument)
    (defalias 'mm-quote-arg 'shell-quote-argument)
  (defun mm-quote-arg (arg)
    "Return a version of ARG that is safe to evaluate in a shell."