X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=sidebyside;f=lisp%2Frfc2047.el;h=ff07547c6d28e3c709ab8fc582b34f452c0abac1;hb=2ee42624a6069cf91f228bdf578e3e5d1f044d5d;hp=74705daa5740f9a073d001fac953f76f64939d19;hpb=cd13ede00e34997d48de2589ea45c0d6a62cf7c4;p=elisp%2Fgnus.git- diff --git a/lisp/rfc2047.el b/lisp/rfc2047.el index 74705da..ff07547 100644 --- a/lisp/rfc2047.el +++ b/lisp/rfc2047.el @@ -1,5 +1,5 @@ ;;; rfc2047.el --- Functions for encoding and decoding rfc2047 messages -;; Copyright (C) 1998,99 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko @@ -46,7 +46,7 @@ The values can be: 1) nil, in which case no encoding is done; 2) `mime', in which case the header will be encoded according to RFC2047; -3) a charset, in which case it will be encoded as that charse; +3) a charset, in which case it will be encoded as that charset; 4) `default', in which case the field will be encoded as the rest of the article.") @@ -80,7 +80,7 @@ Valid encodings are nil, `Q' and `B'.") (defvar rfc2047-q-encoding-alist '(("\\(From\\|Cc\\|To\\|Bcc\||Reply-To\\):" . "-A-Za-z0-9!*+/=_") - ("." . "^\000-\007\013\015-\037\200-\377=_?")) + ("." . "^\000-\007\011\013\015-\037\200-\377=_?")) "Alist of header regexps and valid Q characters.") ;;; @@ -105,33 +105,37 @@ Valid encodings are nil, `Q' and `B'.") "Encode the message header according to `rfc2047-header-encoding-alist'. Should be called narrowed to the head of the message." (interactive "*") - (when (featurep 'mule) - (save-excursion - (goto-char (point-min)) - (let ((alist rfc2047-header-encoding-alist) - elem method) - (while (not (eobp)) - (save-restriction - (rfc2047-narrow-to-field) - (when (rfc2047-encodable-p) - ;; We found something that may perhaps be encoded. - (while (setq elem (pop alist)) - (when (or (and (stringp (car elem)) - (looking-at (car elem))) - (eq (car elem) t)) - (setq alist nil - method (cdr elem)))) - (when method - (cond - ((eq method 'mime) - (rfc2047-encode-region (point-min) (point-max)) - (rfc2047-fold-region (point-min) (point-max))) - ;; Hm. - (t)))) - (goto-char (point-max))))) - (when mail-parse-charset - (encode-coding-region (point-min) (point-max) - mail-parse-charset))))) + (save-excursion + (goto-char (point-min)) + (let ((alist rfc2047-header-encoding-alist) + elem method) + (while (not (eobp)) + (save-restriction + (rfc2047-narrow-to-field) + (if (not (rfc2047-encodable-p)) + (if (and (eq (mm-body-7-or-8) '8bit) + (mm-multibyte-p) + (mm-coding-system-p + (car message-posting-charset))) + ;; 8 bit must be decoded. + ;; Is message-posting-charset a coding system? + (mm-encode-coding-region + (point-min) (point-max) + (car message-posting-charset))) + ;; We found something that may perhaps be encoded. + (while (setq elem (pop alist)) + (when (or (and (stringp (car elem)) + (looking-at (car elem))) + (eq (car elem) t)) + (setq alist nil + method (cdr elem)))) + (cond + ((eq method 'mime) + (rfc2047-encode-region (point-min) (point-max)) + (rfc2047-fold-region (point-min) (point-max))) + ;; Hm. + (t))) + (goto-char (point-max))))))) (defun rfc2047-encodable-p (&optional header) "Say whether the current (narrowed) buffer contains characters that need encoding in headers." @@ -160,11 +164,9 @@ Should be called narrowed to the head of the message." (while (not (eobp)) (cond ((not state) - (if (memq (char-after) blank-list) - (setq state 'blank) - (setq state 'word) - (if (not (eq (setq cs (mm-charset-after)) 'ascii)) - (setq current cs))) + (setq state 'word) + (if (not (eq (setq cs (mm-charset-after)) 'ascii)) + (setq current cs)) (setq b (point))) ((eq state 'blank) (cond @@ -173,6 +175,8 @@ Should be called narrowed to the head of the message." ((memq (char-after) blank-list)) (t (setq state 'word) + (unless b + (setq b (point))) (if (not (eq (setq cs (mm-charset-after)) 'ascii)) (setq current cs))))) ((eq state 'word) @@ -183,9 +187,11 @@ Should be called narrowed to the head of the message." (setq current nil)) ((memq (char-after) blank-list) (setq state 'blank) - (push (list b (point) current) words) - (setq current nil) - (setq b (point))) + (if (not current) + (setq b nil) + (push (list b (point) current) words) + (setq b (point)) + (setq current nil))) ((or (eq (setq cs (mm-charset-after)) 'ascii) (if current (eq current cs) @@ -209,7 +215,14 @@ Should be called narrowed to the head of the message." (if (equal (nth 2 word) current) (setq beg (nth 0 word)) (when current - (rfc2047-encode beg end current)) + (if (and (eq beg (nth 1 word)) (nth 2 word)) + (progn + ;; There might be a bug in Emacs Mule. + ;; A space must be inserted before encoding. + (goto-char beg) + (insert " ") + (rfc2047-encode (1+ beg) (1+ end) current)) + (rfc2047-encode beg end current))) (setq current (nth 2 word) beg (nth 0 word) end (nth 1 word)))) @@ -242,7 +255,9 @@ Should be called narrowed to the head of the message." (goto-char (min (point-max) (+ 15 (point)))) (unless (eobp) (insert "\n")))) - (mm-encode-coding-region (point-min) (point-max) mime-charset) + (if (and (mm-multibyte-p) + (mm-coding-system-p mime-charset)) + (mm-encode-coding-region (point-min) (point-max) mime-charset)) (funcall (cdr (assq encoding rfc2047-encoding-function-alist)) (point-min) (point-max)) (goto-char (point-min)) @@ -268,7 +283,8 @@ Should be called narrowed to the head of the message." ((and (not break) (looking-at "=\\?")) (setq break (point))) - ((and (looking-at "\\?=") + ((and break + (looking-at "\\?=") (> (- (point) (save-excursion (beginning-of-line) (point))) 76)) (goto-char break) (setq break nil)