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

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

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

revision 1.6.4.2 by miles, Tue Oct 14 23:34:51 2003 UTC revision 1.6.4.3 by miles, Thu Sep 16 00:12:16 2004 UTC
# Line 1  Line 1 
1  ;;; mm-encode.el --- functions for encoding MIME things  ;;; mm-encode.el --- Functions for encoding MIME things
2  ;; Copyright (C) 1998, 1999, 2000, 2002 Free Software Foundation, Inc.  ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004
3    ;;        Free Software Foundation, Inc.
4    
5  ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>  ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
6  ;;      MORIOKA Tomohiko <morioka@jaist.ac.jp>  ;;      MORIOKA Tomohiko <morioka@jaist.ac.jp>
# Line 28  Line 29 
29  (require 'mail-parse)  (require 'mail-parse)
30  (require 'mailcap)  (require 'mailcap)
31  (eval-and-compile  (eval-and-compile
32    (autoload 'mm-body-7-or-8 "mm-bodies"))    (autoload 'mm-body-7-or-8 "mm-bodies")
33      (autoload 'mm-long-lines-p "mm-bodies"))
34    
35  (defvar mm-content-transfer-encoding-defaults  (defcustom mm-content-transfer-encoding-defaults
36    '(("text/x-patch" 8bit)    '(("text/x-patch" 8bit)
37      ("text/.*" qp-or-base64)      ("text/.*" qp-or-base64)
38      ("message/rfc822" 8bit)      ("message/rfc822" 8bit)
39      ("application/emacs-lisp" 8bit)      ("application/emacs-lisp" qp-or-base64)
40      ("application/x-emacs-lisp" 8bit)      ("application/x-emacs-lisp" qp-or-base64)
41      ("application/x-patch" 8bit)      ("application/x-patch" qp-or-base64)
42      (".*" base64))      (".*" base64))
43    "Alist of regexps that match MIME types and their encodings.    "Alist of regexps that match MIME types and their encodings.
44  If the encoding is `qp-or-base64', then either quoted-printable  If the encoding is `qp-or-base64', then either quoted-printable
45  or base64 will be used, depending on what is more efficient.")  or base64 will be used, depending on what is more efficient.
46    
47    `qp-or-base64' has another effect.  It will fold long lines so that
48    MIME parts may not be broken by MTA.  So do `quoted-printable' and
49    `base64'.
50    
51    Note: It affects body encoding only when a part is a raw forwarded
52    message (which will be made by `gnus-summary-mail-forward' with the
53    arg 2 for example) or is neither the text/* type nor the message/*
54    type.  Even though in those cases, you can use the `encoding' MML tag
55    to specify encoding of non-ASCII MIME parts."
56      :type '(repeat (list (regexp :tag "MIME type")
57                           (choice :tag "encoding"
58                                   (const 7bit)
59                                   (const 8bit)
60                                   (const qp-or-base64)
61                                   (const quoted-printable)
62                                   (const base64))))
63      :group 'mime)
64    
65  (defvar mm-use-ultra-safe-encoding nil  (defvar mm-use-ultra-safe-encoding nil
66    "If non-nil, use encodings aimed at Procrustean bed survival.    "If non-nil, use encodings aimed at Procrustean bed survival.
# Line 76  This variable should never be set direct Line 96  This variable should never be set direct
96      (mailcap-extension-to-mime (match-string 0 file))))      (mailcap-extension-to-mime (match-string 0 file))))
97    
98  (defun mm-safer-encoding (encoding)  (defun mm-safer-encoding (encoding)
99    "Return a safer but similar encoding."    "Return an encoding similar to ENCODING but safer than it."
100    (cond    (cond
101     ((memq encoding '(7bit 8bit quoted-printable)) 'quoted-printable)     ((eq encoding '7bit) '7bit) ;; 7bit is considered safe.
102       ((memq encoding '(8bit quoted-printable)) 'quoted-printable)
103     ;; The remaining encodings are binary and base64 (and perhaps some     ;; The remaining encodings are binary and base64 (and perhaps some
104     ;; non-standard ones), which are both turned into base64.     ;; non-standard ones), which are both turned into base64.
105     (t 'base64)))     (t 'base64)))
106    
107  (defun mm-encode-content-transfer-encoding (encoding &optional type)  (defun mm-encode-content-transfer-encoding (encoding &optional type)
108      "Encode the current buffer with ENCODING for MIME type TYPE.
109    ENCODING can be: nil (do nothing); one of `quoted-printable', `base64';
110    `7bit', `8bit' or `binary' (all do nothing); a function to do the encoding."
111    (cond    (cond
112     ((eq encoding 'quoted-printable)     ((eq encoding 'quoted-printable)
113        ;; This used to try to make a multibyte buffer unibyte.  That's
114        ;; completely wrong, since you'd get QP-encoded emacs-mule.  If
115        ;; this gets run on multibyte text it's an error that needs
116        ;; fixing, and the encoding function will signal an error.
117        ;; Likewise base64 below.
118      (quoted-printable-encode-region (point-min) (point-max) t))      (quoted-printable-encode-region (point-min) (point-max) t))
119     ((eq encoding 'base64)     ((eq encoding 'base64)
120      (when (equal type "text/plain")      (when (equal type "text/plain")
121        (goto-char (point-min))        (goto-char (point-min))
122        (while (search-forward "\n" nil t)        (while (search-forward "\n" nil t)
123          (replace-match "\r\n" t t)))          (replace-match "\r\n" t t)))
124      (condition-case error      (base64-encode-region (point-min) (point-max)))
         (base64-encode-region (point-min) (point-max))  
       (error  
        (message "Error while decoding: %s" error)  
        nil)))  
125     ((memq encoding '(7bit 8bit binary))     ((memq encoding '(7bit 8bit binary))
126      ;; Do nothing.      ;; Do nothing.
127      )      )
128     ((null encoding)     ((null encoding)
129      ;; Do nothing.      ;; Do nothing.
130      )      )
131       ;; Fixme: Ignoring errors here looks bogus.
132     ((functionp encoding)     ((functionp encoding)
133      (ignore-errors (funcall encoding (point-min) (point-max))))      (ignore-errors (funcall encoding (point-min) (point-max))))
134     (t     (t
135      (message "Unknown encoding %s; defaulting to 8bit" encoding))))      (error "Unknown encoding %s" encoding))))
136    
137  (defun mm-encode-buffer (type)  (defun mm-encode-buffer (type)
138    "Encode the buffer which contains data of TYPE.    "Encode the buffer which contains data of MIME type TYPE.
139    TYPE is a string or a list of the components.
140  The encoding used is returned."  The encoding used is returned."
141    (let* ((mime-type (if (stringp type) type (car type)))    (let* ((mime-type (if (stringp type) type (car type)))
142           (encoding           (encoding
# Line 119  The encoding used is returned." Line 146  The encoding used is returned."
146           (bits (mm-body-7-or-8)))           (bits (mm-body-7-or-8)))
147      ;; We force buffers that are 7bit to be unencoded, no matter      ;; We force buffers that are 7bit to be unencoded, no matter
148      ;; what the preferred encoding is.      ;; what the preferred encoding is.
149      (when (eq bits '7bit)      ;; Only if the buffers don't contain lone lines.
150        (when (and (eq bits '7bit) (not (mm-long-lines-p 76)))
151        (setq encoding bits))        (setq encoding bits))
152      (mm-encode-content-transfer-encoding encoding mime-type)      (mm-encode-content-transfer-encoding encoding mime-type)
153      encoding))      encoding))
# Line 154  The encoding used is returned." Line 182  The encoding used is returned."
182          (pop rules)))))          (pop rules)))))
183    
184  (defun mm-qp-or-base64 ()  (defun mm-qp-or-base64 ()
185    (save-excursion    "Return the type with which to encode the buffer.
186      (let ((limit (min (point-max) (+ 2000 (point-min))))  This is either `base64' or `quoted-printable'."
187            (n8bit 0))    (if (equal mm-use-ultra-safe-encoding '(sign . "pgp"))
188        (goto-char (point-min))        ;; perhaps not always accurate?
189        (skip-chars-forward "\x20-\x7f\r\n\t" limit)        'quoted-printable
190        (while (< (point) limit)      (save-excursion
191          (incf n8bit)        (let ((limit (min (point-max) (+ 2000 (point-min))))
192          (forward-char 1)              (n8bit 0))
193          (skip-chars-forward "\x20-\x7f\r\n\t" limit))          (goto-char (point-min))
194        (if (or (< (* 6 n8bit) (- limit (point-min)))          (skip-chars-forward "\x20-\x7f\r\n\t" limit)
195                ;; Don't base64, say, a short line with a single          (while (< (point) limit)
196                ;; non-ASCII char when splitting parts by charset.            (incf n8bit)
197                (= n8bit 1))            (forward-char 1)
198            'quoted-printable            (skip-chars-forward "\x20-\x7f\r\n\t" limit))
199          'base64))))          (if (or (< (* 6 n8bit) (- limit (point-min)))
200                    ;; Don't base64, say, a short line with a single
201                    ;; non-ASCII char when splitting parts by charset.
202                    (= n8bit 1))
203                'quoted-printable
204              'base64)))))
205    
206  (provide 'mm-encode)  (provide 'mm-encode)
207    

Legend:
Removed from v.1.6.4.2  
changed lines
  Added in v.1.6.4.3

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