[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/gnus/mm-util.el [emacs-unicode-2]
From: |
Miles Bader |
Subject: |
[Emacs-diffs] Changes to emacs/lisp/gnus/mm-util.el [emacs-unicode-2] |
Date: |
Thu, 09 Sep 2004 06:03:11 -0400 |
Index: emacs/lisp/gnus/mm-util.el
diff -c emacs/lisp/gnus/mm-util.el:1.27.6.3 emacs/lisp/gnus/mm-util.el:1.27.6.4
*** emacs/lisp/gnus/mm-util.el:1.27.6.3 Fri Mar 12 00:02:59 2004
--- emacs/lisp/gnus/mm-util.el Thu Sep 9 09:36:26 2004
***************
*** 1,5 ****
;;; mm-util.el --- Utility functions for Mule and low level things
! ;; Copyright (C) 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <address@hidden>
;; MORIOKA Tomohiko <address@hidden>
--- 1,6 ----
;;; mm-util.el --- Utility functions for Mule and low level things
! ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004
! ;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <address@hidden>
;; MORIOKA Tomohiko <address@hidden>
***************
*** 24,32 ****
;;; Code:
! (eval-when-compile
! (require 'cl)
! (defvar mm-mime-mule-charset-alist))
(require 'mail-prsvr)
(eval-and-compile
--- 25,31 ----
;;; Code:
! (eval-when-compile (require 'cl))
(require 'mail-prsvr)
(eval-and-compile
***************
*** 42,48 ****
(coding-system-list . ignore)
(decode-coding-region . ignore)
(char-int . identity)
- (device-type . ignore)
(coding-system-equal . equal)
(annotationp . ignore)
(set-buffer-file-coding-system . ignore)
--- 41,46 ----
***************
*** 71,80 ****
(setq idx (1+ idx)))
string)))
(string-as-unibyte . identity)
(string-as-multibyte . identity)
(multibyte-string-p . ignore)
! (point-at-bol . line-beginning-position)
! (point-at-eol . line-end-position)
(insert-byte . insert-char)
(multibyte-char-to-unibyte . identity))))
--- 69,87 ----
(setq idx (1+ idx)))
string)))
(string-as-unibyte . identity)
+ (string-make-unibyte . identity)
(string-as-multibyte . identity)
(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))))
***************
*** 85,90 ****
--- 92,105 ----
((fboundp 'char-valid-p) 'char-valid-p)
(t 'identity))))
+ ;; Fixme: This seems always to be used to read a MIME charset, so it
+ ;; should be re-named and fixed (in Emacs) to offer completion only on
+ ;; proper charset names (base coding systems which have a
+ ;; mime-charset defined). XEmacs doesn't believe in mime-charset;
+ ;; test with
+ ;; `(or (coding-system-get 'iso-8859-1 'mime-charset)
+ ;; (coding-system-get 'iso-8859-1 :mime-charset))'
+ ;; Actually, there should be an `mm-coding-system-mime-charset'.
(eval-and-compile
(defalias 'mm-read-coding-system
(cond
***************
*** 106,115 ****
(or mm-coding-system-list
(setq mm-coding-system-list (mm-coding-system-list))))
! (defun mm-coding-system-p (sym)
! "Return non-nil if SYM is a coding system."
! (or (and (fboundp 'coding-system-p) (coding-system-p sym))
! (memq sym (mm-get-coding-system-list))))
(defvar mm-charset-synonym-alist
`(
--- 121,135 ----
(or mm-coding-system-list
(setq mm-coding-system-list (mm-coding-system-list))))
! (defun mm-coding-system-p (cs)
! "Return non-nil if CS is a symbol naming a coding system.
! In XEmacs, also return non-nil if CS is a coding system object."
! (if (fboundp 'find-coding-system)
! (find-coding-system cs)
! (if (fboundp 'coding-system-p)
! (coding-system-p cs)
! ;; Is this branch ever actually useful?
! (memq cs (mm-get-coding-system-list)))))
(defvar mm-charset-synonym-alist
`(
***************
*** 122,131 ****
;; Apparently not defined in Emacs 20, but is a valid MIME name.
,@(unless (mm-coding-system-p 'gb2312)
'((gb2312 . cn-gb-2312)))
! ;; ISO-8859-15 is very similar to ISO-8859-1.
! ;; But this is just wrong. --fx
! ,@(unless (mm-coding-system-p 'iso-8859-15) ; Emacs 21 defines it.
'((iso-8859-15 . iso-8859-1)))
;; Windows-1252 is actually a superset of Latin-1. See also
;; `gnus-article-dumbquotes-map'.
,@(unless (mm-coding-system-p 'windows-1252)
--- 142,153 ----
;; Apparently not defined in Emacs 20, but is a valid MIME name.
,@(unless (mm-coding-system-p 'gb2312)
'((gb2312 . cn-gb-2312)))
! ;; ISO-8859-15 is very similar to ISO-8859-1. But it's _different_!
! ,@(unless (mm-coding-system-p 'iso-8859-15)
'((iso-8859-15 . iso-8859-1)))
+ ;; BIG-5HKSCS is similar to, but different than, BIG-5.
+ ,@(unless (mm-coding-system-p 'big5-hkscs)
+ '((big5-hkscs . big5)))
;; Windows-1252 is actually a superset of Latin-1. See also
;; `gnus-article-dumbquotes-map'.
,@(unless (mm-coding-system-p 'windows-1252)
***************
*** 135,144 ****
;; Windows-1250 is a variant of Latin-2 heavily used by Microsoft
;; Outlook users in Czech republic. Use this to allow reading of their
;; e-mails. cp1250 should be defined by M-x codepage-setup.
-
- ;; This is not TRT, the MIME name, windows-1250, should be an
- ;; alias, and cp1250 should have a mime-charset property, per
- ;; code-page.el. -- fx
,@(if (and (not (mm-coding-system-p 'windows-1250))
(mm-coding-system-p 'cp1250))
'((windows-1250 . cp1250)))
--- 157,162 ----
***************
*** 164,170 ****
(defvar mm-auto-save-coding-system
(cond
! ((mm-coding-system-p 'utf-8-emacs)
(if (memq system-type '(windows-nt ms-dos ms-windows))
(if (mm-coding-system-p 'utf-8-emacs-dos)
'utf-8-emacs-dos mm-binary-coding-system)
--- 182,188 ----
(defvar mm-auto-save-coding-system
(cond
! ((mm-coding-system-p 'utf-8-emacs) ; Mule 7
(if (memq system-type '(windows-nt ms-dos ms-windows))
(if (mm-coding-system-p 'utf-8-emacs-dos)
'utf-8-emacs-dos mm-binary-coding-system)
***************
*** 256,278 ****
(coding-system-get cs 'safe-charsets))))))
(sort-coding-systems (coding-system-list 'base-only))))))
! (defvar mm-coding-system-priorities nil
! "Preferred coding systems for encoding outgoing mails.
!
! More than one suitable coding systems may be found for some texts. By
! default, a coding system with the highest priority is used to encode
! outgoing mails (see `sort-coding-systems'). If this variable is set,
! it overrides the default priority. For example, Japanese users may
! prefer iso-2022-jp to japanese-shift-jis:
!
! \(setq mm-coding-system-priorities
! '(iso-2022-jp iso-2022-jp-2 japanese-shift-jis utf-8))
! ")
! ;; Why on earth was this broken out? -- fx
(defvar mm-use-find-coding-systems-region
(fboundp 'find-coding-systems-region)
! "Use `find-coding-systems-region' to find proper coding systems.")
;;; Internal variables:
--- 274,302 ----
(coding-system-get cs 'safe-charsets))))))
(sort-coding-systems (coding-system-list 'base-only))))))
! (defcustom mm-coding-system-priorities
! (if (boundp 'current-language-environment)
! (let ((lang (symbol-value 'current-language-environment)))
! (cond ((string= lang "Japanese")
! ;; Japanese users may prefer iso-2022-jp to shift-jis.
! '(iso-2022-jp iso-2022-jp-2 japanese-shift-jis
! iso-latin-1 utf-8)))))
! "Preferred coding systems for encoding outgoing messages.
!
! More than one suitable coding system may be found for some text.
! By default, the coding system with the highest priority is used
! to encode outgoing messages (see `sort-coding-systems'). If this
! variable is set, it overrides the default priority."
! :type '(repeat (symbol :tag "Coding system"))
! :group 'mime)
! ;; ??
(defvar mm-use-find-coding-systems-region
(fboundp 'find-coding-systems-region)
! "Use `find-coding-systems-region' to find proper coding systems.
!
! Setting it to nil is useful on Emacsen supporting Unicode if sending
! mail with multiple parts is preferred to sending a Unicode one.")
;;; Internal variables:
***************
*** 280,288 ****
(defun mm-mule-charset-to-mime-charset (charset)
"Return the MIME charset corresponding to the given Mule CHARSET."
! (if (fboundp 'find-coding-systems-for-charsets)
(let (mime)
! (dolist (cs (find-coding-systems-for-charsets (list charset)))
(unless mime
(when cs
(setq mime (or (coding-system-get cs :mime-charset)
--- 304,315 ----
(defun mm-mule-charset-to-mime-charset (charset)
"Return the MIME charset corresponding to the given Mule CHARSET."
! (if (and (fboundp 'find-coding-systems-for-charsets)
! (fboundp 'sort-coding-systems))
(let (mime)
! (dolist (cs (sort-coding-systems
! (copy-sequence
! (find-coding-systems-for-charsets (list charset)))))
(unless mime
(when cs
(setq mime (or (coding-system-get cs :mime-charset)
***************
*** 310,316 ****
((null charset)
charset)
;; Running in a non-MULE environment.
! ((null (mm-get-coding-system-list))
charset)
;; ascii
((eq charset 'us-ascii)
--- 337,344 ----
((null charset)
charset)
;; Running in a non-MULE environment.
! ((or (null (mm-get-coding-system-list))
! (not (fboundp 'coding-system-get)))
charset)
;; ascii
((eq charset 'us-ascii)
***************
*** 326,332 ****
charset)
;; Translate invalid charsets.
((let ((cs (cdr (assq charset mm-charset-synonym-alist))))
! (and cs (mm-coding-system-p charset) cs)))
;; Last resort: search the coding system list for entries which
;; have the right mime-charset in case the canonical name isn't
;; defined (though it should be).
--- 354,360 ----
charset)
;; Translate invalid charsets.
((let ((cs (cdr (assq charset mm-charset-synonym-alist))))
! (and cs (mm-coding-system-p cs) cs)))
;; Last resort: search the coding system list for entries which
;; have the right mime-charset in case the canonical name isn't
;; defined (though it should be).
***************
*** 370,375 ****
--- 398,424 ----
(or (get-charset-property charset 'preferred-coding-system)
(get-charset-property charset 'prefered-coding-system)))
+ ;; Mule charsets shouldn't be used.
+ (defsubst mm-guess-charset ()
+ "Guess Mule charset from the language environment."
+ (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)))
+ ;; default
+ 'latin-iso8859-1)))
+ mail-parse-mule-charset)))
+
(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.
***************
*** 386,408 ****
(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)))
! ;; Fixme: don't fix that!
! 'latin-iso8859-1)))
! mail-parse-mule-charset)))))))
(defun mm-mime-charset (charset)
"Return the MIME charset corresponding to the given Mule CHARSET."
--- 435,441 ----
(if (and charset (not (memq charset '(ascii eight-bit-control
eight-bit-graphic))))
charset
! (mm-guess-charset))))))
(defun mm-mime-charset (charset)
"Return the MIME charset corresponding to the given Mule CHARSET."
***************
*** 432,449 ****
(setq result (cons head result)))
(nreverse result)))
! ;; It's not clear whether this is supposed to mean the global or local
! ;; setting. I think it's used inconsistently. -- fx
! (defsubst mm-multibyte-p ()
! "Say whether multibyte is enabled."
(if (and (not (featurep 'xemacs))
(boundp 'enable-multibyte-characters))
! enable-multibyte-characters
! (featurep 'mule)))
(defun mm-sort-coding-systems-predicate (a b)
! (> (length (memq a mm-coding-system-priorities))
! (length (memq b mm-coding-system-priorities))))
(defun mm-find-mime-charset-region (b e)
"Return the MIME charsets needed to encode the region between B and E.
--- 465,497 ----
(setq result (cons head result)))
(nreverse result)))
! ;; Fixme: This is used in places when it should be testing the
! ;; default multibyteness. See mm-default-multibyte-p.
! (eval-and-compile
(if (and (not (featurep 'xemacs))
(boundp 'enable-multibyte-characters))
! (defun mm-multibyte-p ()
! "Non-nil if multibyte is enabled in the current buffer."
! enable-multibyte-characters)
! (defun mm-multibyte-p () (featurep 'mule))))
!
! (defun mm-default-multibyte-p ()
! "Return non-nil if the session is multibyte.
! This affects whether coding conversion should be attempted generally."
! (if (featurep 'mule)
! (if (boundp 'default-enable-multibyte-characters)
! default-enable-multibyte-characters
! t)))
(defun mm-sort-coding-systems-predicate (a b)
! (let ((priorities
! (mapcar (lambda (cs)
! ;; Note: invalid entries are dropped silently
! (and (coding-system-p cs)
! (coding-system-base cs)))
! mm-coding-system-priorities)))
! (> (length (memq a priorities))
! (length (memq b priorities)))))
(defun mm-find-mime-charset-region (b e)
"Return the MIME charsets needed to encode the region between B and E.
***************
*** 459,480 ****
(when mm-coding-system-priorities
(setq systems
(sort systems 'mm-sort-coding-systems-predicate)))
- ;; Fixme: The `mime-charset' (`x-ctext') of `compound-text'
- ;; is not in the IANA list.
(setq systems (delq 'compound-text systems))
(unless (equal systems '(undecided))
(while systems
(let* ((head (pop systems))
(cs (or (coding-system-get head :mime-charset)
(coding-system-get head 'mime-charset))))
! (if cs
(setq systems nil
charsets (list cs))))))
charsets))
;; Fixme: won't work for unibyte Emacs 22:
! ;; Otherwise we're not multibyte, XEmacs or a single coding
! ;; system won't cover it.
(setq charsets
(mm-delete-duplicates
(mapcar 'mm-mime-charset
--- 507,543 ----
(when mm-coding-system-priorities
(setq systems
(sort systems 'mm-sort-coding-systems-predicate)))
(setq systems (delq 'compound-text systems))
(unless (equal systems '(undecided))
(while systems
(let* ((head (pop systems))
(cs (or (coding-system-get head :mime-charset)
(coding-system-get head 'mime-charset))))
! ;; The mime-charset (`x-ctext') of
! ;; `compound-text' is not in the IANA list. We
! ;; shouldn't normally use anything here with a
! ;; mime-charset having an `x-' prefix.
! ;; Fixme: Allow this to be overridden, since
! ;; there is existing use of x-ctext.
! ;; Also people apparently need the coding system
! ;; `iso-2022-jp-3' (which Mule-UCS defines with
! ;; mime-charset, though it's not valid).
! (if (and cs
! (not (string-match "^[Xx]-" (symbol-name cs)))
! ;; UTF-16 of any variety is invalid for
! ;; text parts and, unfortunately, has
! ;; mime-charset defined both in Mule-UCS
! ;; and versions of Emacs. (The name
! ;; might be `mule-utf-16...' or
! ;; `utf-16...'.)
! (not (string-match "utf-16" (symbol-name cs))))
(setq systems nil
charsets (list cs))))))
charsets))
;; Fixme: won't work for unibyte Emacs 22:
! ;; Otherwise we're not multibyte, we're XEmacs, or a single
! ;; coding system won't cover it.
(setq charsets
(mm-delete-duplicates
(mapcar 'mm-mime-charset
***************
*** 490,495 ****
--- 553,566 ----
(put 'mm-with-unibyte-buffer 'lisp-indent-function 0)
(put 'mm-with-unibyte-buffer 'edebug-form-spec '(body))
+ (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.
***************
*** 511,522 ****
(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))
(defun mm-find-charset-region (b e)
"Return a list of Emacs charsets in the region B to E."
(cond
--- 582,600 ----
(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
***************
*** 582,591 ****
(defun mm-insert-file-contents (filename &optional visit beg end replace
inhibit)
! "Like `insert-file-contents', q.v., 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)
--- 660,669 ----
(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)
***************
*** 612,618 ****
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))
--- 690,696 ----
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))
***************
*** 624,636 ****
(append mm-inhibit-file-name-handlers
inhibit-file-name-handlers)
inhibit-file-name-handlers)))
! (append-to-file start end 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))
--- 702,715 ----
(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))
***************
*** 654,672 ****
(push dir result))
(push path result))))
! ;; It is not a MIME function, but some MIME functions use it.
! (defalias 'mm-make-temp-file
! (if (fboundp 'make-temp-file)
! '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))))
(provide 'mm-util)
--- 733,764 ----
(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 (point) (point-max))))
! (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)))
! (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)))
!
(provide 'mm-util)
- [Emacs-diffs] Changes to emacs/lisp/gnus/mm-util.el [emacs-unicode-2],
Miles Bader <=