X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Frfc2047.el;h=87de840e1af5a33f824595272d872712e7ff1d42;hb=b6ecce37cfaeebdf55e548f7970efcdb48d6ebb8;hp=fb76875638d0bce41757d32db512d37caa029327;hpb=c1af3628060f432339bc3bc4a2a23f4a967e8afb;p=gnus diff --git a/lisp/rfc2047.el b/lisp/rfc2047.el index fb7687563..87de840e1 100644 --- a/lisp/rfc2047.el +++ b/lisp/rfc2047.el @@ -121,15 +121,6 @@ quoted-printable and base64 respectively.") (nil . ignore)) "Alist of RFC2047 encodings to encoding functions.") -(defvar rfc2047-q-encoding-alist - '(("\\(Resent-\\)?\\(From\\|Cc\\|To\\|Bcc\\|Reply-To\\|Sender\\):" - . "-A-Za-z0-9!*+/" ) - ;; = (\075), _ (\137), ? (\077) are used in the encoded word. - ;; Avoid using 8bit characters. - ;; Equivalent to "^\000-\007\011\013\015-\037\200-\377=_?" - ("." . "\010\012\014\040-\074\076\100-\136\140-\177")) - "Alist of header regexps and valid Q characters.") - ;;; ;;; Functions for encoding RFC2047 messages ;;; @@ -207,7 +198,7 @@ Should be called narrowed to the head of the message." ((eq method 'address-mime) (rfc2047-encode-region (point) (point-max))) ((eq method 'mime) - (let (rfc2047-encoding-type) + (let ((rfc2047-encoding-type 'mime)) (rfc2047-encode-region (point) (point-max)))) ((eq method 'default) (if (and (featurep 'mule) @@ -272,7 +263,8 @@ The buffer may be narrowed." ;; Play safe and don't assume the form of the word syntax entry -- ;; copy it from ?a. (if (fboundp 'set-char-table-range) ; Emacs - (set-char-table-range table t (aref (standard-syntax-table) ?a)) + (funcall (intern "set-char-table-range") + table t (aref (standard-syntax-table) ?a)) (if (fboundp 'put-char-table) (if (fboundp 'get-char-table) ; warning avoidance (put-char-table t (get-char-table ?a (standard-syntax-table)) @@ -298,13 +290,23 @@ Dynamically bind `rfc2047-encoding-type' to change that." (save-restriction (narrow-to-region b e) (if (eq 'mime rfc2047-encoding-type) - ;; Simple case -- treat as single word. + ;; Simple case. Treat as single word after any initial ASCII + ;; part and before any tailing ASCII part. The leading ASCII + ;; is relevant for instance in Subject headers with `Re:' for + ;; interoperability with non-MIME clients, and we might as + ;; well avoid the tail too. (progn (goto-char (point-min)) ;; Does it need encoding? - (skip-chars-forward "\000-\177" e) + (skip-chars-forward "\000-\177") (unless (eobp) - (rfc2047-encode b e))) + (skip-chars-backward "^ \n") ; beginning of space-delimited word + (rfc2047-encode (point) (progn + (goto-char e) + (skip-chars-backward "\000-\177") + (skip-chars-forward "^ \n") + ;; end of space-delimited word + (point))))) ;; `address-mime' case -- take care of quoted words, comments. (with-syntax-table rfc2047-syntax-table (let ((start) ; start of current token @@ -376,14 +378,15 @@ Dynamically bind `rfc2047-encoding-type' to change that." end (1+ end))) (rfc2047-encode start end) (setq last-encoded t))))) - (error (error "Invalid data for rfc2047 encoding: %s" - (buffer-substring b e))))))) + (error + (message "Invalid data for rfc2047 encoding: %s" + (buffer-substring b e))))))) (rfc2047-fold-region b (point)))) (defun rfc2047-encode-string (string) "Encode words in STRING. By default, the string is treated as containing addresses (see -`rfc2047-special-chars')." +`rfc2047-encoding-type')." (with-temp-buffer (insert string) (rfc2047-encode-region (point-min) (point-max)) @@ -392,7 +395,7 @@ By default, the string is treated as containing addresses (see (defun rfc2047-encode (b e) "Encode the word(s) in the region B to E. By default, the region is treated as containing addresses (see -`rfc2047-special-chars')." +`rfc2047-encoding-type')." (let* ((mime-charset (mm-find-mime-charset-region b e)) (cs (if (> (length mime-charset) 1) ;; Fixme: Instead of this, try to break region into @@ -552,16 +555,16 @@ By default, the region is treated as containing addresses (see (save-excursion (save-restriction (narrow-to-region (goto-char b) e) - (let ((alist rfc2047-q-encoding-alist) - (bol (save-restriction + (let ((bol (save-restriction (widen) (rfc2047-point-at-bol)))) - (while alist - (when (looking-at (caar alist)) - (quoted-printable-encode-region b e nil (cdar alist)) - (subst-char-in-region (point-min) (point-max) ? ?_) - (setq alist nil)) - (pop alist)) + (quoted-printable-encode-region + b e nil + ;; = (\075), _ (\137), ? (\077) are used in the encoded word. + ;; Avoid using 8bit characters. + ;; Equivalent to "^\000-\007\011\013\015-\037\200-\377=_?" + "\010\012\014\040-\074\076\100-\136\140-\177") + (subst-char-in-region (point-min) (point-max) ? ?_) ;; The size of QP encapsulation is about 20, so set limit to ;; 56=76-20. (unless (< (- (point-max) (point-min)) 56) @@ -588,6 +591,12 @@ By default, the region is treated as containing addresses (see ;; Also check whether it needs to worry about delimiting fields like ;; encoding. +;; In fact it's reported that (invalid) encoding of mailboxes in +;; addr-specs is in use, so delimiting fields might help. Probably +;; not decoding a word which isn't properly delimited is good enough +;; and worthwhile (is it more correct or not?), e.g. something like +;; `=?iso-8859-1?q?foo?=@'. + (defun rfc2047-decode-region (start end) "Decode MIME-encoded words in region between START and END." (interactive "r") @@ -704,19 +713,16 @@ If your Emacs implementation can't decode CHARSET, return nil." (when (and (eq cs 'ascii) mail-parse-charset) (setq cs mail-parse-charset)) - ;; Fixme: What's this for? The following comment makes no sense. -- fx - (mm-with-unibyte-current-buffer - ;; In Emacs Mule 4, decoding UTF-8 should be in unibyte mode. - (mm-decode-coding-string - (cond - ((equal "B" encoding) - (base64-decode-string - (rfc2047-pad-base64 string))) - ((equal "Q" encoding) - (quoted-printable-decode-string - (mm-replace-chars-in-string string ?_ ? ))) - (t (error "Invalid encoding: %s" encoding))) - cs))))) + (mm-decode-coding-string + (cond + ((equal "B" encoding) + (base64-decode-string + (rfc2047-pad-base64 string))) + ((equal "Q" encoding) + (quoted-printable-decode-string + (mm-replace-chars-in-string string ?_ ? ))) + (t (error "Invalid encoding: %s" encoding))) + cs)))) (provide 'rfc2047)