X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fmm-util.el;h=dfad2a2ad7a502c14f83cfa56d9b0dcf777cb6f9;hb=cddb4672a1b8d0b3fb03dd1c5cad4b01f9fab219;hp=79454d0c5eeef5e6d0382f3a0400e784a4dc1e31;hpb=c9bd698099731ccbdb758c62c7735a2bc699b100;p=elisp%2Fgnus.git- diff --git a/lisp/mm-util.el b/lisp/mm-util.el index 79454d0..dfad2a2 100644 --- a/lisp/mm-util.el +++ b/lisp/mm-util.el @@ -1,5 +1,5 @@ ;;; mm-util.el --- Utility functions for MIME things -;; Copyright (C) 1998 Free Software Foundation, Inc. +;; Copyright (C) 1998,99 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko @@ -24,11 +24,27 @@ ;;; Code: -(defvar mm-default-coding-system nil - "The default coding system to use.") +(defvar mm-running-xemacs (string-match "XEmacs" emacs-version)) -(defvar mm-known-charsets '(iso-8859-1) - "List of known charsets.") +(defvar mm-running-ntemacs + (and (not mm-running-xemacs) + (string-match "nt" system-configuration))) + +(defvar mm-binary-coding-system + (if mm-running-xemacs + 'binary 'no-conversion) + "100% binary coding system.") + +(defvar mm-text-coding-system + (cond + ((not (fboundp 'coding-system-p)) nil) + (mm-running-xemacs ;; XEmacs + 'no-conversion) + (mm-running-ntemacs ;; NTEmacs + (and (coding-system-p 'raw-text-dos) 'raw-text-dos)) + ((coding-system-p 'raw-text) 'raw-text) ;; Emacs + (t nil)) + "100% text coding system, for removing ^M.") (defvar mm-mime-mule-charset-alist '((us-ascii ascii) @@ -42,15 +58,21 @@ (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-2 japanese-jisx0208) (iso-2022-jp latin-jisx0201 - japanese-jisx0208-1978 japanese-jisx0208) + japanese-jisx0208-1978) (euc-kr korean-ksc5601) (cn-gb-2312 chinese-gb2312) (cn-big5 chinese-big5-1 chinese-big5-2) + (tibetan tibetan) + (thai-tis620 thai-tis620) + (iso-2022-7bit ethiopic arabic-1-column arabic-2-column) (iso-2022-jp-2 latin-iso8859-1 greek-iso8859-7 latin-jisx0201 japanese-jisx0208-1978 chinese-gb2312 japanese-jisx0208 - korean-ksc5601 japanese-jisx0212) + korean-ksc5601 japanese-jisx0212 + katakana-jisx0201) (iso-2022-int-1 latin-iso8859-1 greek-iso8859-7 latin-jisx0201 japanese-jisx0208-1978 chinese-gb2312 japanese-jisx0208 @@ -101,20 +123,15 @@ (or mm-coding-system-list (setq mm-coding-system-list (mm-coding-system-list)))) -(defvar mm-charset-coding-system-alist - (let ((rest - '((gb2312 . cn-gb-2312) - (iso-2022-jp-2 . iso-2022-7bit-ss2) - (x-ctext . ctext))) - (systems (mm-get-coding-system-list)) - dest) - (while rest - (let ((pair (car rest))) - (unless (memq (car pair) systems) - (setq dest (cons pair dest)))) - (setq rest (cdr rest))) - dest) - "Charset/coding system alist.") +(defvar mm-charset-synonym-alist + '((big5 . cn-big5) + (gb2312 . cn-gb-2312) + (x-ctext . ctext)) + "A mapping from invalid charset names to the real charset names.") + +;;; Internal variables: + +;;; Functions: (defun mm-mule-charset-to-mime-charset (charset) "Return the MIME charset corresponding to MULE CHARSET." @@ -135,14 +152,13 @@ used as the line break code type of the coding system." (when (stringp charset) (setq charset (intern (downcase charset)))) (setq charset - (or (cdr (assq charset mm-charset-coding-system-alist)) + (or (cdr (assq charset mm-charset-synonym-alist)) charset)) (when lbt (setq charset (intern (format "%s-%s" charset lbt)))) (cond ;; Running in a non-MULE environment. - ((and (null (mm-get-coding-system-list)) - (memq charset mm-known-charsets)) + ((null (mm-get-coding-system-list)) charset) ;; ascii ((eq charset 'us-ascii) @@ -169,7 +185,7 @@ used as the line break code type of the coding system." (defsubst mm-enable-multibyte () "Enable multibyte in the current buffer." (when (and (fboundp 'set-buffer-multibyte) - (default-value enable-multibyte-characters)) + (default-value 'enable-multibyte-characters)) (set-buffer-multibyte t))) (defsubst mm-disable-multibyte () @@ -177,22 +193,30 @@ used as the line break code type of the coding system." (when (fboundp 'set-buffer-multibyte) (set-buffer-multibyte nil))) -(defun mm-mime-charset (charset b e) +(defun mm-mime-charset (charset) + "Return the MIME charset corresponding to the MULE CHARSET." (if (fboundp 'coding-system-get) + ;; This exists in Emacs 20. (or - (and - mm-default-coding-system - (let ((safe (coding-system-get mm-default-coding-system - 'safe-charsets))) - (or (eq safe t) (memq charset safe))) - (coding-system-get mm-default-coding-system 'mime-charset)) - (coding-system-get - (get-charset-property charset 'prefered-coding-system) - 'mime-charset) - (car (memq charset (find-coding-systems-region - (point-min) (point-max))))) + (and (get-charset-property charset 'prefered-coding-system) + (coding-system-get + (get-charset-property charset 'prefered-coding-system) + 'mime-charset)) + (and (eq charset 'ascii) + 'us-ascii) + (get-charset-property charset 'prefered-coding-system) + (mm-mule-charset-to-mime-charset charset)) + ;; This is for XEmacs. (mm-mule-charset-to-mime-charset charset))) +(defun mm-find-mime-charset-region (b e) + "Return the MIME charsets needed to encode the region between B and E." + (let ((charsets + (mapcar 'mm-mime-charset + (delq 'ascii + (mm-find-charset-region b e))))) + (delete-duplicates charsets))) + (defsubst mm-multibyte-p () "Say whether multibyte is enabled." (and (boundp 'enable-multibyte-characters) @@ -205,7 +229,7 @@ See also `with-temp-file' and `with-output-to-string'." (multibyte (make-symbol "multibyte"))) `(if (not (boundp 'enable-multibyte-characters)) (with-temp-buffer ,@forms) - (let ((,multibyte (default-value enable-multibyte-characters)) + (let ((,multibyte (default-value 'enable-multibyte-characters)) ,temp-buffer) (unwind-protect (progn @@ -214,7 +238,9 @@ See also `with-temp-file' and `with-output-to-string'." (get-buffer-create (generate-new-buffer-name " *temp*"))) (unwind-protect (with-current-buffer ,temp-buffer - (let (buffer-file-coding-system) + (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)) ,@forms)) (and (buffer-name ,temp-buffer) (kill-buffer ,temp-buffer)))) @@ -222,6 +248,44 @@ See also `with-temp-file' and `with-output-to-string'." (put 'mm-with-unibyte-buffer 'lisp-indent-function 0) (put 'mm-with-unibyte-buffer 'edebug-form-spec '(body)) +(defun mm-find-charset-region (b e) + "Return a list of charsets in the region." + (cond + ((and (boundp 'enable-multibyte-characters) + enable-multibyte-characters + (fboundp 'find-charset-region)) + (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 mail-parse-charset)))))) + (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 (capitalize current-language-environment) + language-info-alist))) + (skip-chars-forward "\0-\177") + (if (eobp) + '(ascii) + (list 'ascii (car (last (assq 'charset entry))))))))))) + +(defun mm-read-charset (prompt) + "Return a charset." + (intern + (completing-read + prompt + (mapcar (lambda (e) (list (symbol-name (car e)))) + mm-mime-mule-charset-alist) + nil t))) + (provide 'mm-util) ;;; mm-util.el ends here