/[emacs]/emacs/lisp/gnus/mm-util.el
ViewVC logotype

Diff of /emacs/lisp/gnus/mm-util.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.27.6.6 by miles, Wed Sep 29 07:22:15 2004 UTC revision 1.27.6.7 by miles, Thu Nov 4 08:55:29 2004 UTC
# Line 123  Line 123 
123    
124  (defun mm-coding-system-p (cs)  (defun mm-coding-system-p (cs)
125    "Return non-nil if CS is a symbol naming a coding system.    "Return non-nil if CS is a symbol naming a coding system.
126  In XEmacs, also return non-nil if CS is a coding system object."  In XEmacs, also return non-nil if CS is a coding system object.
127    If CS is available, return CS itself in Emacs, and return a coding
128    system object in XEmacs."
129    (if (fboundp 'find-coding-system)    (if (fboundp 'find-coding-system)
130        (find-coding-system cs)        (find-coding-system cs)
131      (if (fboundp 'coding-system-p)      (if (fboundp 'coding-system-p)
132          (coding-system-p cs)          (when (coding-system-p cs)
133              cs)
134        ;; Is this branch ever actually useful?        ;; Is this branch ever actually useful?
135        (memq cs (mm-get-coding-system-list)))))        (car (memq cs (mm-get-coding-system-list))))))
136    
137  (defvar mm-charset-synonym-alist  (defvar mm-charset-synonym-alist
138    `(    `(
# Line 219  In XEmacs, also return non-nil if CS is Line 222  In XEmacs, also return non-nil if CS is
222      (big5 chinese-big5-1 chinese-big5-2)      (big5 chinese-big5-1 chinese-big5-2)
223      (tibetan tibetan)      (tibetan tibetan)
224      (thai-tis620 thai-tis620)      (thai-tis620 thai-tis620)
225        (windows-1251 cyrillic-iso8859-5)
226      (iso-2022-7bit ethiopic arabic-1-column arabic-2-column)      (iso-2022-7bit ethiopic arabic-1-column arabic-2-column)
227      (iso-2022-jp-2 latin-iso8859-1 greek-iso8859-7      (iso-2022-jp-2 latin-iso8859-1 greek-iso8859-7
228                     latin-jisx0201 japanese-jisx0208-1978                     latin-jisx0201 japanese-jisx0208-1978
229                     chinese-gb2312 japanese-jisx0208                     chinese-gb2312 japanese-jisx0208
230                     korean-ksc5601 japanese-jisx0212                     korean-ksc5601 japanese-jisx0212)
                    katakana-jisx0201)  
231      (iso-2022-int-1 latin-iso8859-1 greek-iso8859-7      (iso-2022-int-1 latin-iso8859-1 greek-iso8859-7
232                      latin-jisx0201 japanese-jisx0208-1978                      latin-jisx0201 japanese-jisx0208-1978
233                      chinese-gb2312 japanese-jisx0208                      chinese-gb2312 japanese-jisx0208
# Line 239  In XEmacs, also return non-nil if CS is Line 242  In XEmacs, also return non-nil if CS is
242                      chinese-cns11643-3 chinese-cns11643-4                      chinese-cns11643-3 chinese-cns11643-4
243                      chinese-cns11643-5 chinese-cns11643-6                      chinese-cns11643-5 chinese-cns11643-6
244                      chinese-cns11643-7)                      chinese-cns11643-7)
245        (iso-2022-jp-3 latin-jisx0201 japanese-jisx0208-1978 japanese-jisx0208
246                       japanese-jisx0213-1 japanese-jisx0213-2)
247        (shift_jis latin-jisx0201 katakana-jisx0201 japanese-jisx0208)
248      ,(if (or (not (fboundp 'charsetp)) ;; non-Mule case      ,(if (or (not (fboundp 'charsetp)) ;; non-Mule case
249               (charsetp 'unicode-a)               (charsetp 'unicode-a)
250               (not (mm-coding-system-p 'mule-utf-8)))               (not (mm-coding-system-p 'mule-utf-8)))
# Line 249  In XEmacs, also return non-nil if CS is Line 255  In XEmacs, also return non-nil if CS is
255                         (coding-system-get 'mule-utf-8 'safe-charsets)))))                         (coding-system-get 'mule-utf-8 'safe-charsets)))))
256    "Alist of MIME-charset/MULE-charsets.")    "Alist of MIME-charset/MULE-charsets.")
257    
258  ;; Correct by construction, but should be unnecessary:  (defun mm-enrich-utf-8-by-mule-ucs ()
259  ;; XEmacs hates it.    "Make the `utf-8' MIME charset usable by the Mule-UCS package.
260  (when (and (not (featurep 'xemacs))  This function will run when the `un-define' module is loaded under
261             (fboundp 'coding-system-list)  XEmacs, and fill the `utf-8' entry in `mm-mime-mule-charset-alist'
262             (fboundp 'sort-coding-systems))  with Mule charsets.  It is completely useless for Emacs."
263    (setq mm-mime-mule-charset-alist    (unless (cdr (delete '(mm-enrich-utf-8-by-mule-ucs)
264          (apply                         (assoc "un-define" after-load-alist)))
265           'nconc      (setq after-load-alist
266           (mapcar            (delete '("un-define") after-load-alist)))
267            (lambda (cs)    (when (boundp 'unicode-basic-translation-charset-order-list)
268              (when (and (or (coding-system-get cs :mime-charset) ; Emacs 22      (condition-case nil
269                             (coding-system-get cs 'mime-charset))          (let ((val (delq
270                         (not (eq t (coding-system-get cs 'safe-charsets))))                      'ascii
271                (list (cons (or (coding-system-get cs :mime-charset)                      (copy-sequence
272                                (coding-system-get cs 'mime-charset))                       (symbol-value
273                            (delq 'ascii                        'unicode-basic-translation-charset-order-list))))
274                                  (coding-system-get cs 'safe-charsets))))))                (elem (assq 'utf-8 mm-mime-mule-charset-alist)))
275            (sort-coding-systems (coding-system-list 'base-only))))))            (if elem
276                  (setcdr elem val)
277                (setq mm-mime-mule-charset-alist
278                      (nconc mm-mime-mule-charset-alist
279                             (list (cons 'utf-8 val))))))
280          (error))))
281    
282    ;; Correct by construction, but should be unnecessary for Emacs:
283    (if (featurep 'xemacs)
284        (eval-after-load "un-define" '(mm-enrich-utf-8-by-mule-ucs))
285      (when (and (fboundp 'coding-system-list)
286                 (fboundp 'sort-coding-systems))
287        (let ((css (sort-coding-systems (coding-system-list 'base-only)))
288              cs mime mule alist)
289          (while css
290            (setq cs (pop css)
291                  mime (or (coding-system-get cs :mime-charset) ; Emacs 22
292                           (coding-system-get cs 'mime-charset)))
293            (when (and mime
294                       (not (eq t (setq mule
295                                        (coding-system-get cs 'safe-charsets))))
296                       (not (assq mime alist)))
297              (push (cons mime (delq 'ascii mule)) alist)))
298          (setq mm-mime-mule-charset-alist (nreverse alist)))))
299    
300  (defcustom mm-coding-system-priorities  (defcustom mm-coding-system-priorities
301    (if (boundp 'current-language-environment)    (if (boundp 'current-language-environment)
302        (let ((lang (symbol-value 'current-language-environment)))        (let ((lang (symbol-value 'current-language-environment)))
303          (cond ((string= lang "Japanese")          (cond ((string= lang "Japanese")
304                 ;; Japanese users may prefer iso-2022-jp to shift-jis.                 ;; Japanese users prefer iso-2022-jp to euc-japan or
305                 '(iso-2022-jp iso-2022-jp-2 japanese-shift-jis                 ;; shift_jis, however iso-8859-1 should be used when
306                               iso-latin-1 utf-8)))))                 ;; there are only ASCII text and Latin-1 characters.
307                   '(iso-8859-1 iso-2022-jp iso-2022-jp-2 shift_jis utf-8)))))
308    "Preferred coding systems for encoding outgoing messages.    "Preferred coding systems for encoding outgoing messages.
309    
310  More than one suitable coding system may be found for some text.  More than one suitable coding system may be found for some text.
# Line 301  mail with multiple parts is preferred to Line 331  mail with multiple parts is preferred to
331    "Return the MIME charset corresponding to the given Mule CHARSET."    "Return the MIME charset corresponding to the given Mule CHARSET."
332    (if (and (fboundp 'find-coding-systems-for-charsets)    (if (and (fboundp 'find-coding-systems-for-charsets)
333             (fboundp 'sort-coding-systems))             (fboundp 'sort-coding-systems))
334        (let (mime)        (let ((css (sort (sort-coding-systems
335          (dolist (cs (sort-coding-systems                          (find-coding-systems-for-charsets (list charset)))
336                       (copy-sequence                         'mm-sort-coding-systems-predicate))
337                        (find-coding-systems-for-charsets (list charset)))))              cs mime)
338            (unless mime          (while (and (not mime)
339              (when cs                      css)
340                (setq mime (or (coding-system-get cs :mime-charset)            (when (setq cs (pop css))
341                               (coding-system-get cs 'mime-charset))))))              (setq mime (or (coding-system-get cs :mime-charset)
342                               (coding-system-get cs 'mime-charset)))))
343          mime)          mime)
344      (let ((alist mm-mime-mule-charset-alist)      (let ((alist (mapcar (lambda (cs)
345                               (assq cs mm-mime-mule-charset-alist))
346                             (sort (mapcar 'car mm-mime-mule-charset-alist)
347                                   'mm-sort-coding-systems-predicate)))
348            out)            out)
349        (while alist        (while alist
350          (when (memq charset (cdar alist))          (when (memq charset (cdar alist))
# Line 482  This affects whether coding conversion s Line 516  This affects whether coding conversion s
516    (let ((priorities    (let ((priorities
517           (mapcar (lambda (cs)           (mapcar (lambda (cs)
518                     ;; Note: invalid entries are dropped silently                     ;; Note: invalid entries are dropped silently
519                     (and (coding-system-p cs)                     (and (setq cs (mm-coding-system-p cs))
520                          (coding-system-base cs)))                          (coding-system-base cs)))
521                   mm-coding-system-priorities)))                   mm-coding-system-priorities)))
522      (> (length (memq a priorities))      (and (setq a (mm-coding-system-p a))
523         (length (memq b priorities)))))           (if (setq b (mm-coding-system-p b))
524                 (> (length (memq (coding-system-base a) priorities))
525                    (length (memq (coding-system-base b) priorities)))
526               t))))
527    
528  (defun mm-find-mime-charset-region (b e)  (defun mm-find-mime-charset-region (b e)
529    "Return the MIME charsets needed to encode the region between B and E.    "Return the MIME charsets needed to encode the region between B and E.

Legend:
Removed from v.1.27.6.6  
changed lines
  Added in v.1.27.6.7

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26