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

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

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

revision 1.6 by pj, Sun Jul 15 17:42:53 2001 UTC revision 1.6.8.1 by miles, Fri Apr 4 06:20:21 2003 UTC
# Line 1  Line 1 
1  ;;; mm-bodies.el --- functions for decoding MIME things  ;;; mm-bodies.el --- functions for decoding MIME things
2  ;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.  ;; Copyright (C) 1998, 1999, 2000, 2002 Free Software Foundation, Inc.
3    
4  ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>  ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
5  ;;      MORIOKA Tomohiko <morioka@jaist.ac.jp>  ;;      MORIOKA Tomohiko <morioka@jaist.ac.jp>
# Line 56  Valid encodings are `7bit', `8bit', `quo Line 56  Valid encodings are `7bit', `8bit', `quo
56  (defun mm-encode-body ()  (defun mm-encode-body ()
57    "Encode a body.    "Encode a body.
58  Should be called narrowed to the body that is to be encoded.  Should be called narrowed to the body that is to be encoded.
59  If there is more than one non-ASCII MULE charset, then list of found  If there is more than one non-ASCII Mule charset, then the list of found
60  MULE charsets are returned.  Mule charsets is returned.
61  If successful, the MIME charset is returned.  If successful, the MIME charset is returned.
62  If no encoding was done, nil is returned."  If no encoding was done, nil is returned."
63    (if (not (mm-multibyte-p))    (if (not (mm-multibyte-p))
# Line 73  If no encoding was done, nil is returned Line 73  If no encoding was done, nil is returned
73            nil))            nil))
74      (save-excursion      (save-excursion
75        (goto-char (point-min))        (goto-char (point-min))
76        (let ((charsets (mm-find-mime-charset-region (point-min) (point-max)))        (let ((charsets (mm-find-mime-charset-region (point-min) (point-max))))
             charset)  
77          (cond          (cond
78           ;; No encoding.           ;; No encoding.
79           ((null charsets)           ((null charsets)
# Line 84  If no encoding was done, nil is returned Line 83  If no encoding was done, nil is returned
83            charsets)            charsets)
84           ;; We encode.           ;; We encode.
85           (t           (t
86            (let ((charset (car charsets))            (mm-encode-coding-region (point-min) (point-max)
87                  start)                                     (mm-charset-to-coding-system
88              (when (or t                                      (car charsets)))
89                        ;; We always decode.            (car charsets)))))))
                       (not (mm-coding-system-equal  
                             charset buffer-file-coding-system)))  
               (while (not (eobp))  
                 (if (eq (mm-charset-after) 'ascii)  
                     (when start  
                       (save-restriction  
                         (narrow-to-region start (point))  
                         (mm-encode-coding-region  
                          start (point) (mm-charset-to-coding-system charset))  
                         (goto-char (point-max)))  
                       (setq start nil))  
                   (unless start  
                     (setq start (point))))  
                 (forward-char 1))  
               (when start  
                 (mm-encode-coding-region start (point)  
                                          (mm-charset-to-coding-system charset))  
                 (setq start nil)))  
             charset)))))))  
90    
91  (eval-when-compile (defvar message-posting-charset))  (eval-when-compile (defvar message-posting-charset))
92    
# Line 133  If no encoding was done, nil is returned Line 113  If no encoding was done, nil is returned
113    
114  (defun mm-body-7-or-8 ()  (defun mm-body-7-or-8 ()
115    "Say whether the body is 7bit or 8bit."    "Say whether the body is 7bit or 8bit."
116    (cond    (if (save-excursion
117     ((not (featurep 'mule))          (goto-char (point-min))
118      (if (save-excursion          (skip-chars-forward mm-7bit-chars)
119            (goto-char (point-min))          (eobp))
120            (skip-chars-forward mm-7bit-chars)        '7bit
121            (eobp))      '8bit))
         '7bit  
       '8bit))  
    (t  
     ;; Mule version  
     (if (and (null (delq 'ascii  
                          (mm-find-charset-region (point-min) (point-max))))  
              ;;!!!The following is necessary because the function  
              ;;!!!above seems to return the wrong result under  
              ;;!!!Emacs 20.3.  Sometimes.  
              (save-excursion  
                (goto-char (point-min))  
                (skip-chars-forward mm-7bit-chars)  
                (eobp)))  
         '7bit  
       '8bit))))  
122    
123  ;;;  ;;;
124  ;;; Functions for decoding  ;;; Functions for decoding
# Line 213  If no encoding was done, nil is returned Line 178  If no encoding was done, nil is returned
178  The characters in CHARSET should then be decoded."  The characters in CHARSET should then be decoded."
179    (if (stringp charset)    (if (stringp charset)
180        (setq charset (intern (downcase charset))))        (setq charset (intern (downcase charset))))
181    (if (or (not charset)    (if (or (not charset)
182            (eq 'gnus-all mail-parse-ignored-charsets)            (eq 'gnus-all mail-parse-ignored-charsets)
183            (memq 'gnus-all mail-parse-ignored-charsets)            (memq 'gnus-all mail-parse-ignored-charsets)
184            (memq charset mail-parse-ignored-charsets))            (memq charset mail-parse-ignored-charsets))
# Line 226  The characters in CHARSET should then be Line 191  The characters in CHARSET should then be
191          (if (and (not coding-system)          (if (and (not coding-system)
192                   (listp mail-parse-ignored-charsets)                   (listp mail-parse-ignored-charsets)
193                   (memq 'gnus-unknown mail-parse-ignored-charsets))                   (memq 'gnus-unknown mail-parse-ignored-charsets))
194              (setq coding-system              (setq coding-system
195                    (mm-charset-to-coding-system mail-parse-charset)))                    (mm-charset-to-coding-system mail-parse-charset)))
196          (when (and charset coding-system          (when (and charset coding-system
197                     ;; buffer-file-coding-system                     ;; buffer-file-coding-system
# Line 242  The characters in CHARSET should then be Line 207  The characters in CHARSET should then be
207    "Decode STRING with CHARSET."    "Decode STRING with CHARSET."
208    (when (stringp charset)    (when (stringp charset)
209      (setq charset (intern (downcase charset))))      (setq charset (intern (downcase charset))))
210    (when (or (not charset)    (when (or (not charset)
211              (eq 'gnus-all mail-parse-ignored-charsets)              (eq 'gnus-all mail-parse-ignored-charsets)
212              (memq 'gnus-all mail-parse-ignored-charsets)              (memq 'gnus-all mail-parse-ignored-charsets)
213              (memq charset mail-parse-ignored-charsets))              (memq charset mail-parse-ignored-charsets))
# Line 253  The characters in CHARSET should then be Line 218  The characters in CHARSET should then be
218         (if (and (not coding-system)         (if (and (not coding-system)
219                  (listp mail-parse-ignored-charsets)                  (listp mail-parse-ignored-charsets)
220                  (memq 'gnus-unknown mail-parse-ignored-charsets))                  (memq 'gnus-unknown mail-parse-ignored-charsets))
221             (setq coding-system             (setq coding-system
222                   (mm-charset-to-coding-system mail-parse-charset)))                   (mm-charset-to-coding-system mail-parse-charset)))
223         (when (and charset coding-system         (when (and charset coding-system
224                    (mm-multibyte-p)                    (mm-multibyte-p)

Legend:
Removed from v.1.6  
changed lines
  Added in v.1.6.8.1

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