/[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.20 by zsh, Thu Nov 1 15:29:49 2001 UTC revision 1.21 by zsh, Sun Nov 25 15:17:24 2001 UTC
# Line 163  Line 163 
163    "Coding system of auto save file.")    "Coding system of auto save file.")
164    
165  (defvar mm-universal-coding-system mm-auto-save-coding-system  (defvar mm-universal-coding-system mm-auto-save-coding-system
166    "The universal Coding system.")    "The universal coding system.")
167    
168  ;; Fixme: some of the cars here aren't valid MIME charsets.  That  ;; Fixme: some of the cars here aren't valid MIME charsets.  That
169  ;; should only matter with XEmacs, though.  ;; should only matter with XEmacs, though.
# Line 238  Line 238 
238                                  (coding-system-get cs 'safe-charsets))))))                                  (coding-system-get cs 'safe-charsets))))))
239            (sort-coding-systems (coding-system-list 'base-only))))))            (sort-coding-systems (coding-system-list 'base-only))))))
240    
241    (defvar mm-hack-charsets '(iso-8859-15 iso-2022-jp-2)
242      "A list of special charsets.
243    Valid elements include:
244    `iso-8859-15'    convert ISO-8859-1, -9 to ISO-8859-15 if ISO-8859-15 exists.
245    `iso-2022-jp-2'  convert ISO-2022-jp to ISO-2022-jp-2 if ISO-2022-jp-2 exists."
246    )
247    
248    (defvar mm-iso-8859-15-compatible
249      '((iso-8859-1 "\xA4\xA6\xA8\xB4\xB8\xBC\xBD\xBE")
250        (iso-8859-9 "\xA4\xA6\xA8\xB4\xB8\xBC\xBD\xBE\xD0\xDD\xDE\xF0\xFD\xFE"))
251      "ISO-8859-15 exchangeable coding systems and inconvertible characters.")
252    
253    (defvar mm-iso-8859-x-to-15-table
254      (and (fboundp 'coding-system-p)
255           (mm-coding-system-p 'iso-8859-15)
256           (mapcar
257            (lambda (cs)
258              (if (mm-coding-system-p (car cs))
259                  (let ((c (string-to-char
260                            (decode-coding-string "\341" (car cs)))))
261                    (cons (char-charset c)
262                          (cons
263                           (- (string-to-char
264                               (decode-coding-string "\341" 'iso-8859-15)) c)
265                           (string-to-list (decode-coding-string (car (cdr cs))
266                                                                 (car cs))))))
267                '(gnus-charset 0)))
268            mm-iso-8859-15-compatible))
269      "A table of the difference character between ISO-8859-X and ISO-8859-15.")
270    
271    (defvar mm-coding-system-priorities nil
272      "Preferred coding systems for encoding outgoing mails.
273    
274    More than one suitable coding systems may be found for some texts.  By
275    default, a coding system with the highest priority is used to encode
276    outgoing mails (see `sort-coding-systems').  If this variable is set,
277    it overrides the default priority.  For example, Japanese users may
278    prefer iso-2022-jp to japanese-shift-jis:
279    
280    \(setq mm-coding-system-priorities
281      '(iso-2022-jp iso-2022-jp-2 japanese-shift-jis utf-8))
282    ")
283    
284  ;;; Internal variables:  ;;; Internal variables:
285    
286  ;;; Functions:  ;;; Functions:
# Line 270  used as the line break code type of the Line 313  used as the line break code type of the
313    (when lbt    (when lbt
314      (setq charset (intern (format "%s-%s" charset lbt))))      (setq charset (intern (format "%s-%s" charset lbt))))
315    (cond    (cond
316       ((null charset)
317        charset)
318     ;; Running in a non-MULE environment.     ;; Running in a non-MULE environment.
319     ((null (mm-get-coding-system-list))     ((null (mm-get-coding-system-list))
320      charset)      charset)
# Line 348  Only used in Emacs Mule 4." Line 393  Only used in Emacs Mule 4."
393    
394  (defun mm-preferred-coding-system (charset)  (defun mm-preferred-coding-system (charset)
395    ;; A typo in some Emacs versions.    ;; A typo in some Emacs versions.
396    (or (get-charset-property charset 'prefered-coding-system)    (or (get-charset-property charset 'preferred-coding-system)
397        (get-charset-property charset 'preferred-coding-system)))        (get-charset-property charset 'prefered-coding-system)))
398    
399  (defun mm-charset-after (&optional pos)  (defun mm-charset-after (&optional pos)
400    "Return charset of a character in current buffer at position POS.    "Return charset of a character in current buffer at position POS.
# Line 420  If the charset is `composition', return Line 465  If the charset is `composition', return
465        enable-multibyte-characters        enable-multibyte-characters
466      (featurep 'mule)))      (featurep 'mule)))
467    
468  (defun mm-find-mime-charset-region (b e)  (defun mm-iso-8859-x-to-15-region (&optional b e)
469      (if (fboundp 'char-charset)
470          (let (charset item c inconvertible)
471            (save-restriction
472              (if e (narrow-to-region b e))
473              (goto-char (point-min))
474              (skip-chars-forward "\0-\177")
475              (while (not (eobp))
476                (cond
477                 ((not (setq item (assq (char-charset (setq c (char-after)))
478                                        mm-iso-8859-x-to-15-table)))
479                  (forward-char))
480                 ((memq c (cdr (cdr item)))
481                  (setq inconvertible t)
482                  (forward-char))
483                 (t
484                  (insert (prog1 (+ c (car (cdr item))) (delete-char 1))))
485                (skip-chars-forward "\0-\177"))))
486            (not inconvertible))))
487    
488    (defun mm-sort-coding-systems-predicate (a b)
489      (> (length (memq a mm-coding-system-priorities))
490         (length (memq b mm-coding-system-priorities))))
491    
492    (defun mm-find-mime-charset-region (b e &optional hack-charsets)
493    "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.
494  Nil means ASCII, a single-element list represents an appropriate MIME  Nil means ASCII, a single-element list represents an appropriate MIME
495  charset, and a longer list means no appropriate charset."  charset, and a longer list means no appropriate charset."
496    ;; The return possibilities of this function are a mess...    (let (charsets)
497    (or (and      ;; The return possibilities of this function are a mess...
498         (mm-multibyte-p)      (or (and (mm-multibyte-p)
499         (fboundp 'find-coding-systems-region)               (fboundp 'find-coding-systems-region)
500         ;; Find the mime-charset of the most preferred coding               ;; Find the mime-charset of the most preferred coding
501         ;; system that has one.               ;; system that has one.
502         (let ((systems (find-coding-systems-region b e))               (let ((systems (find-coding-systems-region b e)))
503               result)                 (when mm-coding-system-priorities
504           ;; Fixme: The `mime-charset' (`x-ctext') of `compound-text'                   (setq systems
505           ;; is not in the IANA list.                         (sort systems 'mm-sort-coding-systems-predicate)))
506           (setq systems (delq 'compound-text systems))                 ;; Fixme: The `mime-charset' (`x-ctext') of `compound-text'
507           (unless (equal systems '(undecided))                 ;; is not in the IANA list.
508             (while systems                 (setq systems (delq 'compound-text systems))
509               (let ((cs (coding-system-get (pop systems) 'mime-charset)))                 (unless (equal systems '(undecided))
510                 (if cs                   (while systems
511                     (setq systems nil                     (let ((cs (coding-system-get (pop systems) 'mime-charset)))
512                           result (list cs))))))                       (if cs
513           result))                           (setq systems nil
514        ;; Otherwise we're not multibyte, XEmacs or a single coding                                 charsets (list cs))))))
515        ;; system won't cover it.                 charsets))
516        (let ((charsets          ;; Otherwise we're not multibyte, XEmacs or a single coding
517               (mm-delete-duplicates          ;; system won't cover it.
518                (mapcar 'mm-mime-charset          (setq charsets
519                        (delq 'ascii                (mm-delete-duplicates
520                              (mm-find-charset-region b e))))))                 (mapcar 'mm-mime-charset
521          (if (memq 'iso-2022-jp-2 charsets)                         (delq 'ascii
522              (delq 'iso-2022-jp charsets)                               (mm-find-charset-region b e))))))
523            charsets))))      (if (and (memq 'iso-8859-15 charsets)
524                 (memq 'iso-8859-15 hack-charsets)
525                 (save-excursion (mm-iso-8859-x-to-15-region b e)))
526            (mapcar (lambda (x) (setq charsets (delq (car x) charsets)))
527                    mm-iso-8859-15-compatible))
528        (if (and (memq 'iso-2022-jp-2 charsets)
529                 (memq 'iso-2022-jp-2 hack-charsets))
530            (setq charsets (delq 'iso-2022-jp charsets)))
531        charsets))
532    
533  (defmacro mm-with-unibyte-buffer (&rest forms)  (defmacro mm-with-unibyte-buffer (&rest forms)
534    "Create a temporary buffer, and evaluate FORMS there like `progn'.    "Create a temporary buffer, and evaluate FORMS there like `progn'.

Legend:
Removed from v.1.20  
changed lines
  Added in v.1.21

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