← Back to branch summary

~ubuntu-branches/ubuntu/karmic/emacs-snapshot/karmic

« back to all changes in this revision

Viewing changes to lisp/gnus/mm-util.el

  • Committer: Bazaar Package Importer
  • Author(s): Reinhard Tartler
  • Date: 2009-04-05 09:14:30 UTC
  • mfrom: (1.1.30 upstream)
  • Revision ID: james.westby@ubuntu.com-20090405091430-kdbnqkmwgbtzraxs
Tags: 1:20090320-1ubuntu1
upload to jaunty

Show diffs side-by-side

added added

removed removed

Lines of Context:
lisp/gnus/mm-util.el
1
1
;;; mm-util.el --- Utility functions for Mule and low level things
2
2
 
3
3
;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4
 
;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.
 
4
;;   2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
5
5
 
6
6
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
7
7
;;      MORIOKA Tomohiko <morioka@jaist.ac.jp>
40
40
 
41
41
(defvar mm-mime-mule-charset-alist )
42
42
 
 
43
;; Emulate functions that are not available in every (X)Emacs version.
 
44
;; The name of a function is prefixed with mm-, like `mm-char-int' for
 
45
;; `char-int' that is a native XEmacs function, not available in Emacs.
 
46
;; Gnus programs all should use mm- functions, not the original ones.
43
47
(eval-and-compile
44
48
  (mapc
45
49
   (lambda (elem)
47
51
       (if (fboundp (car elem))
48
52
           (defalias nfunc (car elem))
49
53
         (defalias nfunc (cdr elem)))))
50
 
   '((coding-system-list . ignore)
 
54
   `(;; `coding-system-list' is not available in XEmacs 21.4 built
 
55
     ;; without the `file-coding' feature.
 
56
     (coding-system-list . ignore)
 
57
     ;; `char-int' is an XEmacs function, not available in Emacs.
51
58
     (char-int . identity)
 
59
     ;; `coding-system-equal' is an Emacs function, not available in XEmacs.
52
60
     (coding-system-equal . equal)
 
61
     ;; `annotationp' is an XEmacs function, not available in Emacs.
53
62
     (annotationp . ignore)
 
63
     ;; `set-buffer-file-coding-system' is not available in XEmacs 21.4
 
64
     ;; built without the `file-coding' feature.
54
65
     (set-buffer-file-coding-system . ignore)
 
66
     ;; `read-charset' is an Emacs function, not available in XEmacs.
55
67
     (read-charset
56
 
      . (lambda (prompt)
57
 
          "Return a charset."
58
 
          (intern
59
 
           (completing-read
60
 
            prompt
61
 
            (mapcar (lambda (e) (list (symbol-name (car e))))
62
 
                    mm-mime-mule-charset-alist)
63
 
            nil t))))
 
68
      . ,(lambda (prompt)
 
69
           "Return a charset."
 
70
           (intern
 
71
            (completing-read
 
72
             prompt
 
73
             (mapcar (lambda (e) (list (symbol-name (car e))))
 
74
                     mm-mime-mule-charset-alist)
 
75
             nil t))))
 
76
     ;; `subst-char-in-string' is not available in XEmacs 21.4.
64
77
     (subst-char-in-string
65
 
      . (lambda (from to string &optional inplace)
66
 
          ;; stolen (and renamed) from nnheader.el
67
 
          "Replace characters in STRING from FROM to TO.
 
78
      . ,(lambda (from to string &optional inplace)
 
79
           ;; stolen (and renamed) from nnheader.el
 
80
           "Replace characters in STRING from FROM to TO.
68
81
          Unless optional argument INPLACE is non-nil, return a new string."
69
 
          (let ((string (if inplace string (copy-sequence string)))
70
 
                (len (length string))
71
 
                (idx 0))
72
 
            ;; Replace all occurrences of FROM with TO.
73
 
            (while (< idx len)
74
 
              (when (= (aref string idx) from)
75
 
                (aset string idx to))
76
 
              (setq idx (1+ idx)))
77
 
            string)))
 
82
           (let ((string (if inplace string (copy-sequence string)))
 
83
                 (len (length string))
 
84
                 (idx 0))
 
85
             ;; Replace all occurrences of FROM with TO.
 
86
             (while (< idx len)
 
87
               (when (= (aref string idx) from)
 
88
                 (aset string idx to))
 
89
               (setq idx (1+ idx)))
 
90
             string)))
 
91
     ;; `replace-in-string' is an XEmacs function, not available in Emacs.
78
92
     (replace-in-string
79
 
      . (lambda (string regexp rep &optional literal)
80
 
          "See `replace-regexp-in-string', only the order of args differs."
81
 
          (replace-regexp-in-string regexp rep string nil literal)))
 
93
      . ,(lambda (string regexp rep &optional literal)
 
94
           "See `replace-regexp-in-string', only the order of args differs."
 
95
           (replace-regexp-in-string regexp rep string nil literal)))
 
96
     ;; `string-as-unibyte' is an Emacs function, not available in XEmacs.
82
97
     (string-as-unibyte . identity)
 
98
     ;; `string-make-unibyte' is an Emacs function, not available in XEmacs.
83
99
     (string-make-unibyte . identity)
84
100
     ;; string-as-multibyte often doesn't really do what you think it does.
85
101
     ;; Example:
99
115
     ;; (string-as-multibyte s)   ~= (decode-coding-string s 'emacs-mule)
100
116
     ;; (string-to-multibyte s)   ~= (decode-coding-string s 'binary)
101
117
     ;; (string-make-multibyte s) ~= (decode-coding-string s locale-coding-system)
 
118
     ;; `string-as-multibyte' is an Emacs function, not available in XEmacs.
102
119
     (string-as-multibyte . identity)
 
120
     ;; `multibyte-string-p' is an Emacs function, not available in XEmacs.
103
121
     (multibyte-string-p . ignore)
 
122
     ;; `insert-byte' is available only in Emacs 23.1 or greater.
104
123
     (insert-byte . insert-char)
 
124
     ;; `multibyte-char-to-unibyte' is an Emacs function, not available
 
125
     ;; in XEmacs.
105
126
     (multibyte-char-to-unibyte . identity)
 
127
     ;; `set-buffer-multibyte' is an Emacs function, not available in XEmacs.
106
128
     (set-buffer-multibyte . ignore)
 
129
     ;; `special-display-p' is an Emacs function, not available in XEmacs.
107
130
     (special-display-p
108
 
      . (lambda (buffer-name)
109
 
          "Returns non-nil if a buffer named BUFFER-NAME gets a special frame."
110
 
          (and special-display-function
111
 
               (or (and (member buffer-name special-display-buffer-names) t)
112
 
                   (cdr (assoc buffer-name special-display-buffer-names))
113
 
                   (catch 'return
114
 
                     (dolist (elem special-display-regexps)
115
 
                       (and (stringp elem)
116
 
                            (string-match elem buffer-name)
117
 
                            (throw 'return t))
118
 
                       (and (consp elem)
119
 
                            (stringp (car elem))
120
 
                            (string-match (car elem) buffer-name)
121
 
                            (throw 'return (cdr elem))))))))))))
122
 
 
 
131
      . ,(lambda (buffer-name)
 
132
           "Returns non-nil if a buffer named BUFFER-NAME gets a special frame."
 
133
           (and special-display-function
 
134
                (or (and (member buffer-name special-display-buffer-names) t)
 
135
                    (cdr (assoc buffer-name special-display-buffer-names))
 
136
                    (catch 'return
 
137
                      (dolist (elem special-display-regexps)
 
138
                        (and (stringp elem)
 
139
                             (string-match elem buffer-name)
 
140
                             (throw 'return t))
 
141
                        (and (consp elem)
 
142
                             (stringp (car elem))
 
143
                             (string-match (car elem) buffer-name)
 
144
                             (throw 'return (cdr elem)))))))))
 
145
     ;; `substring-no-properties' is available only in Emacs 22.1 or greater.
 
146
     (substring-no-properties
 
147
      . ,(lambda (string &optional from to)
 
148
           "Return a substring of STRING, without text properties.
 
149
It starts at index FROM and ending before TO.
 
150
TO may be nil or omitted; then the substring runs to the end of STRING.
 
151
If FROM is nil or omitted, the substring starts at the beginning of STRING.
 
152
If FROM or TO is negative, it counts from the end.
 
153
 
 
154
With one argument, just copy STRING without its properties."
 
155
           (setq string (substring string (or from 0) to))
 
156
           (set-text-properties 0 (length string) nil string)
 
157
           string))
 
158
     ;; `line-number-at-pos' is available only in Emacs 22.1 or greater
 
159
     ;; and XEmacs 21.5.
 
160
     (line-number-at-pos
 
161
      . ,(lambda (&optional pos)
 
162
           "Return (narrowed) buffer line number at position POS.
 
163
If POS is nil, use current buffer location.
 
164
Counting starts at (point-min), so the value refers
 
165
to the contents of the accessible portion of the buffer."
 
166
           (let ((opoint (or pos (point))) start)
 
167
             (save-excursion
 
168
               (goto-char (point-min))
 
169
               (setq start (point))
 
170
               (goto-char opoint)
 
171
               (forward-line 0)
 
172
               (1+ (count-lines start (point))))))))))
 
173
 
 
174
;; `decode-coding-string', `encode-coding-string', `decode-coding-region'
 
175
;; and `encode-coding-region' are available in Emacs and XEmacs built with
 
176
;; the `file-coding' feature, but the XEmacs versions treat nil, that is
 
177
;; given as the `coding-system' argument, as the `binary' coding system.
123
178
(eval-and-compile
124
179
  (if (featurep 'xemacs)
125
180
      (if (featurep 'file-coding)
126
 
          ;; Don't modify string if CODING-SYSTEM is nil.
127
181
          (progn
128
182
            (defun mm-decode-coding-string (str coding-system)
129
183
              (if coding-system
148
202
    (defalias 'mm-decode-coding-region 'decode-coding-region)
149
203
    (defalias 'mm-encode-coding-region 'encode-coding-region)))
150
204
 
 
205
;; `string-to-multibyte' is available only in Emacs 22.1 or greater.
151
206
(defalias 'mm-string-to-multibyte
152
207
  (cond
153
208
   ((featurep 'xemacs)
156
211
    'string-to-multibyte)
157
212
   (t
158
213
    (lambda (string)
159
 
      "Return a multibyte string with the same individual chars as string."
 
214
      "Return a multibyte string with the same individual chars as STRING."
160
215
      (mapconcat
161
216
       (lambda (ch) (mm-string-as-multibyte (char-to-string ch)))
162
217
       string "")))))
163
218
 
 
219
;; `char-or-char-int-p' is an XEmacs function, not available in Emacs.
164
220
(eval-and-compile
165
221
  (defalias 'mm-char-or-char-int-p
166
222
    (cond
168
224
     ((fboundp 'char-valid-p) 'char-valid-p)
169
225
     (t 'identity))))
170
226
 
 
227
;; `ucs-to-char' is a function that Mule-UCS provides.
 
228
(if (featurep 'xemacs)
 
229
    (cond ((and (fboundp 'unicode-to-char) ;; XEmacs 21.5.
 
230
                (subrp (symbol-function 'unicode-to-char)))
 
231
           (if (featurep 'mule)
 
232
               (defalias 'mm-ucs-to-char 'unicode-to-char)
 
233
             (defun mm-ucs-to-char (codepoint)
 
234
               "Convert Unicode codepoint to character."
 
235
               (or (unicode-to-char codepoint) ?#))))
 
236
          ((featurep 'mule)
 
237
           (defun mm-ucs-to-char (codepoint)
 
238
             "Convert Unicode codepoint to character."
 
239
             (if (fboundp 'ucs-to-char) ;; Mule-UCS is loaded.
 
240
                 (progn
 
241
                   (defalias 'mm-ucs-to-char
 
242
                     (lambda (codepoint)
 
243
                       "Convert Unicode codepoint to character."
 
244
                       (condition-case nil
 
245
                           (or (ucs-to-char codepoint) ?#)
 
246
                         (error ?#))))
 
247
                   (mm-ucs-to-char codepoint))
 
248
               (condition-case nil
 
249
                   (or (int-to-char codepoint) ?#)
 
250
                 (error ?#)))))
 
251
          (t
 
252
           (defun mm-ucs-to-char (codepoint)
 
253
             "Convert Unicode codepoint to character."
 
254
             (condition-case nil
 
255
                 (or (int-to-char codepoint) ?#)
 
256
               (error ?#)))))
 
257
  (if (let ((char (make-char 'japanese-jisx0208 36 34)))
 
258
        (eq char (decode-char 'ucs char)))
 
259
      ;; Emacs 23.
 
260
      (defalias 'mm-ucs-to-char 'identity)
 
261
    (defun mm-ucs-to-char (codepoint)
 
262
      "Convert Unicode codepoint to character."
 
263
      (or (decode-char 'ucs codepoint) ?#))))
 
264
 
171
265
;; Fixme:  This seems always to be used to read a MIME charset, so it
172
266
;; should be re-named and fixed (in Emacs) to offer completion only on
173
267
;; proper charset names (base coding systems which have a
269
363
    ,@(when (and (not (mm-coding-system-p 'gbk))
270
364
                 (mm-coding-system-p 'cp936))
271
365
        '((gbk . cp936)))
 
366
    ;; UTF8 is a bogus name for UTF-8
 
367
    ,@(when (and (not (mm-coding-system-p 'utf8))
 
368
                 (mm-coding-system-p 'utf-8))
 
369
        '((utf8 . utf-8)))
272
370
    ;; ISO8859-1 is a bogus name for ISO-8859-1
273
371
    ,@(when (and (not (mm-coding-system-p 'iso8859-1))
274
372
                 (mm-coding-system-p 'iso-8859-1))
275
373
        '((iso8859-1 . iso-8859-1)))
 
374
    ;; ISO_8859-1 is a bogus name for ISO-8859-1
 
375
    ,@(when (and (not (mm-coding-system-p 'iso_8859-1))
 
376
                 (mm-coding-system-p 'iso-8859-1))
 
377
        '((iso_8859-1 . iso-8859-1)))
276
378
    )
277
379
  "A mapping from unknown or invalid charset names to the real charset names.
278
380
 
388
490
(mm-setup-codepage-iso-8859)
389
491
(mm-setup-codepage-ibm)
390
492
 
391
 
(defcustom mm-charset-override-alist
392
 
  '((iso-8859-1 . windows-1252)
393
 
    (iso-8859-8 . windows-1255)
394
 
    (iso-8859-9 . windows-1254))
395
 
  "A mapping from undesired charset names to their replacement.
396
 
 
397
 
You may add pairs like (iso-8859-1 . windows-1252) here,
398
 
i.e. treat iso-8859-1 as windows-1252.  windows-1252 is a
399
 
superset of iso-8859-1."
400
 
  :type '(list (set :inline t
401
 
                    (const (iso-8859-1 . windows-1252))
402
 
                    (const (iso-8859-8 . windows-1255))
403
 
                    (const (iso-8859-9 . windows-1254))
404
 
                    (const (undecided  . windows-1252)))
405
 
               (repeat :inline t
406
 
                       :tag "Other options"
407
 
                       (cons (symbol :tag "From charset")
408
 
                             (symbol :tag "To charset"))))
409
 
  :version "22.1" ;; Gnus 5.10.9
410
 
  :group 'mime)
411
 
 
 
493
;; Note: this has to be defined before `mm-charset-to-coding-system'.
412
494
(defcustom mm-charset-eval-alist
413
495
  (if (featurep 'xemacs)
414
496
      nil ;; I don't know what would be useful for XEmacs.
437
519
  :group 'mime)
438
520
(put 'mm-charset-eval-alist 'risky-local-variable t)
439
521
 
 
522
(defvar mm-charset-override-alist)
 
523
 
 
524
;; Note: this function has to be defined before `mm-charset-override-alist'
 
525
;; since it will use this function in order to determine its default value
 
526
;; when loading mm-util.elc.
 
527
(defun mm-charset-to-coding-system (charset &optional lbt
 
528
                                            allow-override silent)
 
529
  "Return coding-system corresponding to CHARSET.
 
530
CHARSET is a symbol naming a MIME charset.
 
531
If optional argument LBT (`unix', `dos' or `mac') is specified, it is
 
532
used as the line break code type of the coding system.
 
533
 
 
534
If ALLOW-OVERRIDE is given, use `mm-charset-override-alist' to
 
535
map undesired charset names to their replacement.  This should
 
536
only be used for decoding, not for encoding.
 
537
 
 
538
A non-nil value of SILENT means don't issue a warning even if CHARSET
 
539
is not available."
 
540
  ;; OVERRIDE is used (only) in `mm-decode-body' and `mm-decode-string'.
 
541
  (when (stringp charset)
 
542
    (setq charset (intern (downcase charset))))
 
543
  (when lbt
 
544
    (setq charset (intern (format "%s-%s" charset lbt))))
 
545
  (cond
 
546
   ((null charset)
 
547
    charset)
 
548
   ;; Running in a non-MULE environment.
 
549
   ((or (null (mm-get-coding-system-list))
 
550
        (not (fboundp 'coding-system-get)))
 
551
    charset)
 
552
   ;; Check override list quite early.  Should only used for decoding, not for
 
553
   ;; encoding!
 
554
   ((and allow-override
 
555
         (let ((cs (cdr (assq charset mm-charset-override-alist))))
 
556
           (and cs (mm-coding-system-p cs) cs))))
 
557
   ;; ascii
 
558
   ((eq charset 'us-ascii)
 
559
    'ascii)
 
560
   ;; Check to see whether we can handle this charset.  (This depends
 
561
   ;; on there being some coding system matching each `mime-charset'
 
562
   ;; property defined, as there should be.)
 
563
   ((and (mm-coding-system-p charset)
 
564
;;; Doing this would potentially weed out incorrect charsets.
 
565
;;;      charset
 
566
;;;      (eq charset (coding-system-get charset 'mime-charset))
 
567
         )
 
568
    charset)
 
569
   ;; Eval expressions from `mm-charset-eval-alist'
 
570
   ((let* ((el (assq charset mm-charset-eval-alist))
 
571
           (cs (car el))
 
572
           (form (cdr el)))
 
573
      (and cs
 
574
           form
 
575
           (prog2
 
576
               ;; Avoid errors...
 
577
               (condition-case nil (eval form) (error nil))
 
578
               ;; (message "Failed to eval `%s'" form))
 
579
               (mm-coding-system-p cs)
 
580
             (message "Added charset `%s' via `mm-charset-eval-alist'" cs))
 
581
           cs)))
 
582
   ;; Translate invalid charsets.
 
583
   ((let ((cs (cdr (assq charset mm-charset-synonym-alist))))
 
584
      (and cs
 
585
           (mm-coding-system-p cs)
 
586
           ;; (message
 
587
           ;;  "Using synonym `%s' from `mm-charset-synonym-alist' for `%s'"
 
588
           ;;  cs charset)
 
589
           cs)))
 
590
   ;; Last resort: search the coding system list for entries which
 
591
   ;; have the right mime-charset in case the canonical name isn't
 
592
   ;; defined (though it should be).
 
593
   ((let (cs)
 
594
      ;; mm-get-coding-system-list returns a list of cs without lbt.
 
595
      ;; Do we need -lbt?
 
596
      (dolist (c (mm-get-coding-system-list))
 
597
        (if (and (null cs)
 
598
                 (eq charset (or (coding-system-get c :mime-charset)
 
599
                                 (coding-system-get c 'mime-charset))))
 
600
            (setq cs c)))
 
601
      (unless (or silent cs)
 
602
        ;; Warn the user about unknown charset:
 
603
        (if (fboundp 'gnus-message)
 
604
            (gnus-message 7 "Unknown charset: %s" charset)
 
605
          (message "Unknown charset: %s" charset)))
 
606
      cs))))
 
607
 
 
608
;; Note: `mm-charset-to-coding-system' has to be defined before this.
 
609
(defcustom mm-charset-override-alist
 
610
  ;; Note: pairs that cannot be used in the Emacs version currently running
 
611
  ;; will be removed.
 
612
  '((gb2312 . gbk)
 
613
    (iso-8859-1 . windows-1252)
 
614
    (iso-8859-8 . windows-1255)
 
615
    (iso-8859-9 . windows-1254))
 
616
  "A mapping from undesired charset names to their replacement.
 
617
 
 
618
You may add pairs like (iso-8859-1 . windows-1252) here,
 
619
i.e. treat iso-8859-1 as windows-1252.  windows-1252 is a
 
620
superset of iso-8859-1."
 
621
  :type
 
622
  '(list
 
623
    :convert-widget
 
624
    (lambda (widget)
 
625
      (let ((defaults
 
626
              (delq nil
 
627
                    (mapcar (lambda (pair)
 
628
                              (if (mm-charset-to-coding-system (cdr pair)
 
629
                                                               nil nil t)
 
630
                                  pair))
 
631
                            '((gb2312 . gbk)
 
632
                              (iso-8859-1 . windows-1252)
 
633
                              (iso-8859-8 . windows-1255)
 
634
                              (iso-8859-9 . windows-1254)
 
635
                              (undecided  . windows-1252)))))
 
636
            (val (copy-sequence (default-value 'mm-charset-override-alist)))
 
637
            pair rest)
 
638
        (while val
 
639
          (push (if (and (prog1
 
640
                             (setq pair (assq (caar val) defaults))
 
641
                           (setq defaults (delq pair defaults)))
 
642
                         (equal (car val) pair))
 
643
                    `(const ,pair)
 
644
                  `(cons :format "%v"
 
645
                         (const :format "(%v" ,(caar val))
 
646
                         (symbol :size 3 :format " . %v)\n" ,(cdar val))))
 
647
                rest)
 
648
          (setq val (cdr val)))
 
649
        (while defaults
 
650
          (push `(const ,(pop defaults)) rest))
 
651
        (widget-convert
 
652
         'list
 
653
         `(set :inline t :format "%v" ,@(nreverse rest))
 
654
         `(repeat :inline t :tag "Other options"
 
655
                  (cons :format "%v"
 
656
                        (symbol :size 3 :format "(%v")
 
657
                        (symbol :size 3 :format " . %v)\n")))))))
 
658
  ;; Remove pairs that cannot be used in the Emacs version currently
 
659
  ;; running.  Note that this section will be evaluated when loading
 
660
  ;; mm-util.elc.
 
661
  :set (lambda (symbol value)
 
662
         (custom-set-default
 
663
          symbol (delq nil
 
664
                       (mapcar (lambda (pair)
 
665
                                 (if (mm-charset-to-coding-system (cdr pair)
 
666
                                                                  nil nil t)
 
667
                                     pair))
 
668
                               value))))
 
669
  :version "22.1" ;; Gnus 5.10.9
 
670
  :group 'mime)
 
671
 
440
672
(defvar mm-binary-coding-system
441
673
  (cond
442
674
   ((mm-coding-system-p 'binary) 'binary)
608
840
  "A table of the difference character between ISO-8859-X and ISO-8859-15.")
609
841
 
610
842
(defcustom mm-coding-system-priorities
611
 
  (if (boundp 'current-language-environment)
612
 
      (let ((lang (symbol-value 'current-language-environment)))
613
 
        (cond ((string= lang "Japanese")
614
 
               ;; Japanese users prefer iso-2022-jp to euc-japan or
615
 
               ;; shift_jis, however iso-8859-1 should be used when
616
 
               ;; there are only ASCII text and Latin-1 characters.
617
 
               '(iso-8859-1 iso-2022-jp iso-2022-jp-2 shift_jis utf-8)))))
 
843
  (let ((lang (if (boundp 'current-language-environment)
 
844
                  (symbol-value 'current-language-environment))))
 
845
    (cond (;; XEmacs without Mule but with `file-coding'.
 
846
           (not lang) nil)
 
847
          ;; In XEmacs 21.5 it may be the one like "Japanese (UTF-8)".
 
848
          ((string-match "\\`Japanese" lang)
 
849
           ;; Japanese users prefer iso-2022-jp to euc-japan or
 
850
           ;; shift_jis, however iso-8859-1 should be used when
 
851
           ;; there are only ASCII text and Latin-1 characters.
 
852
           '(iso-8859-1 iso-2022-jp iso-2022-jp-2 shift_jis utf-8))))
618
853
  "Preferred coding systems for encoding outgoing messages.
619
854
 
620
855
More than one suitable coding system may be found for some text.
663
898
        (pop alist))
664
899
      out)))
665
900
 
666
 
(defun mm-charset-to-coding-system (charset &optional lbt
667
 
                                            allow-override)
668
 
  "Return coding-system corresponding to CHARSET.
669
 
CHARSET is a symbol naming a MIME charset.
670
 
If optional argument LBT (`unix', `dos' or `mac') is specified, it is
671
 
used as the line break code type of the coding system.
672
 
 
673
 
If ALLOW-OVERRIDE is given, use `mm-charset-override-alist' to
674
 
map undesired charset names to their replacement.  This should
675
 
only be used for decoding, not for encoding."
676
 
  ;; OVERRIDE is used (only) in `mm-decode-body' and `mm-decode-string'.
677
 
  (when (stringp charset)
678
 
    (setq charset (intern (downcase charset))))
679
 
  (when lbt
680
 
    (setq charset (intern (format "%s-%s" charset lbt))))
681
 
  (cond
682
 
   ((null charset)
683
 
    charset)
684
 
   ;; Running in a non-MULE environment.
685
 
   ((or (null (mm-get-coding-system-list))
686
 
        (not (fboundp 'coding-system-get)))
687
 
    charset)
688
 
   ;; Check override list quite early.  Should only used for decoding, not for
689
 
   ;; encoding!
690
 
   ((and allow-override
691
 
         (let ((cs (cdr (assq charset mm-charset-override-alist))))
692
 
           (and cs (mm-coding-system-p cs) cs))))
693
 
   ;; ascii
694
 
   ((eq charset 'us-ascii)
695
 
    'ascii)
696
 
   ;; Check to see whether we can handle this charset.  (This depends
697
 
   ;; on there being some coding system matching each `mime-charset'
698
 
   ;; property defined, as there should be.)
699
 
   ((and (mm-coding-system-p charset)
700
 
;;; Doing this would potentially weed out incorrect charsets.
701
 
;;;      charset
702
 
;;;      (eq charset (coding-system-get charset 'mime-charset))
703
 
         )
704
 
    charset)
705
 
   ;; Eval expressions from `mm-charset-eval-alist'
706
 
   ((let* ((el (assq charset mm-charset-eval-alist))
707
 
           (cs (car el))
708
 
           (form (cdr el)))
709
 
      (and cs
710
 
           form
711
 
           (prog2
712
 
               ;; Avoid errors...
713
 
               (condition-case nil (eval form) (error nil))
714
 
               ;; (message "Failed to eval `%s'" form))
715
 
               (mm-coding-system-p cs)
716
 
             (message "Added charset `%s' via `mm-charset-eval-alist'" cs))
717
 
           cs)))
718
 
   ;; Translate invalid charsets.
719
 
   ((let ((cs (cdr (assq charset mm-charset-synonym-alist))))
720
 
      (and cs
721
 
           (mm-coding-system-p cs)
722
 
           ;; (message
723
 
           ;;  "Using synonym `%s' from `mm-charset-synonym-alist' for `%s'"
724
 
           ;;  cs charset)
725
 
           cs)))
726
 
   ;; Last resort: search the coding system list for entries which
727
 
   ;; have the right mime-charset in case the canonical name isn't
728
 
   ;; defined (though it should be).
729
 
   ((let (cs)
730
 
      ;; mm-get-coding-system-list returns a list of cs without lbt.
731
 
      ;; Do we need -lbt?
732
 
      (dolist (c (mm-get-coding-system-list))
733
 
        (if (and (null cs)
734
 
                 (eq charset (or (coding-system-get c :mime-charset)
735
 
                                 (coding-system-get c 'mime-charset))))
736
 
            (setq cs c)))
737
 
      (unless cs
738
 
        ;; Warn the user about unknown charset:
739
 
        (if (fboundp 'gnus-message)
740
 
            (gnus-message 7 "Unknown charset: %s" charset)
741
 
          (message "Unknown charset: %s" charset)))
742
 
      cs))))
743
 
 
744
901
(eval-and-compile
745
902
  (defvar mm-emacs-mule (and (not (featurep 'xemacs))
746
903
                             (boundp 'default-enable-multibyte-characters)