X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Frfc2047.el;h=4c2a8d17bcb7143d6b9892b459af38b444854ec2;hb=d48c014e9def24a6c0de92967e489c06923343c0;hp=f15fa98dc0d6ce8ef4c15d9a0c87e5eff77a27a4;hpb=9dc12b9ca22173804a9fe992e95f0feb774bf828;p=elisp%2Fgnus.git- diff --git a/lisp/rfc2047.el b/lisp/rfc2047.el index f15fa98..4c2a8d1 100644 --- a/lisp/rfc2047.el +++ b/lisp/rfc2047.el @@ -25,10 +25,13 @@ ;;; Code: (eval-and-compile - (if (not (fboundp 'base64-encode-string)) - (require 'base64))) + (eval + '(unless (fboundp 'base64-decode-string) + (require 'base64)))) + (require 'qp) (require 'mm-util) +(require 'ietf-drums) (defvar rfc2047-default-charset 'iso-8859-1 "Default MIME charset -- does not need encoding.") @@ -55,8 +58,8 @@ The values can be: (iso-8859-2 . Q) (iso-8859-3 . Q) (iso-8859-4 . Q) - (iso-8859-5 . Q) - (koi8-r . Q) + (iso-8859-5 . B) + (koi8-r . B) (iso-8859-7 . Q) (iso-8859-8 . Q) (iso-8859-9 . Q) @@ -73,13 +76,13 @@ Valid encodings are nil, `Q' and `B'.") (defvar rfc2047-encoding-function-alist '((Q . rfc2047-q-encode-region) - (B . base64-encode-region) + (B . rfc2047-b-encode-region) (nil . ignore)) "Alist of RFC2047 encodings to encoding functions.") (defvar rfc2047-q-encoding-alist - '(("\\(From\\|Cc\\|To\\|Bcc\||Reply-To\\):" . "[^-A-Za-z0-9!*+/=_]") - ("." . "[\000-\007\013\015-\037\200-\377=_?]")) + '(("\\(From\\|Cc\\|To\\|Bcc\||Reply-To\\):" . "-A-Za-z0-9!*+/=_") + ("." . "^\000-\007\013\015-\037\200-\377=_?")) "Alist of header regexps and valid Q characters.") ;;; @@ -100,13 +103,13 @@ Valid encodings are nil, `Q' and `B'.") (point-max)))) (goto-char (point-min))) -;;;###autoload (defun rfc2047-encode-message-header () "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)) @@ -140,36 +143,37 @@ Should be called narrowed to the head of the message." (setq found t))) found)) +(defun rfc2047-dissect-region (b e) + "Dissect the region between B and E." + (let (words) + (save-restriction + (narrow-to-region b e) + (goto-char (point-min)) + (while (re-search-forward + (concat "[^" ietf-drums-tspecials " \t\n]+") nil t) + (push + (list (match-beginning 0) (match-end 0) + (car + (delq 'ascii + (find-charset-region (match-beginning 0) + (match-end 0))))) + words)) + words))) + (defun rfc2047-encode-region (b e) "Encode all encodable words in REGION." - (let (prev c start qstart qprev qend) - (save-excursion - (goto-char b) - (while (re-search-forward "[^ \t\n]+" nil t) - (save-restriction - (narrow-to-region (match-beginning 0) (match-end 0)) - (goto-char (setq start (point-min))) - (setq prev nil) - (while (not (eobp)) - (unless (eq (setq c (char-charset (following-char))) 'ascii) - (cond - ((eq c prev) - ) - ((null prev) - (setq qstart (or qstart start) - qend (point-max) - qprev c) - (setq prev c)) - (t - ;(rfc2047-encode start (setq start (point)) prev) - (setq prev c)))) - (forward-char 1))) - (when (and (not prev) qstart) - (rfc2047-encode qstart qend qprev) - (setq qstart nil))) - (when qstart - (rfc2047-encode qstart qend qprev) - (setq qstart nil))))) + (let ((words (rfc2047-dissect-region b e)) + beg end current word) + (while (setq word (pop words)) + (if (equal (nth 2 word) current) + (setq beg (nth 0 word)) + (when current + (rfc2047-encode beg end current)) + (setq current (nth 2 word) + beg (nth 0 word) + end (nth 1 word)))) + (when current + (rfc2047-encode beg end current)))) (defun rfc2047-encode-string (string) "Encode words in STRING." @@ -180,29 +184,38 @@ Should be called narrowed to the head of the message." (defun rfc2047-encode (b e charset) "Encode the word in the region with CHARSET." - (let* ((mime-charset (mm-mule-charset-to-mime-charset charset)) - (encoding (cdr (assq mime-charset - rfc2047-charset-encoding-alist))) + (let* ((mime-charset + (mm-mime-charset charset b e)) + (encoding (or (cdr (assq mime-charset + rfc2047-charset-encoding-alist)) + 'B)) (start (concat "=?" (downcase (symbol-name mime-charset)) "?" - (downcase (symbol-name encoding)) "?"))) + (downcase (symbol-name encoding)) "?")) + (first t)) (save-restriction (narrow-to-region b e) (mm-encode-coding-region b e mime-charset) (funcall (cdr (assq encoding rfc2047-encoding-function-alist)) (point-min) (point-max)) (goto-char (point-min)) - (insert start) - (goto-char (point-max)) - (insert "?=") - ;; Encoded words can't be more than 75 chars long, so we have to - ;; split the long ones up. - (end-of-line) - (while (> (current-column) 74) - (beginning-of-line) - (forward-char 73) - (insert "?=\n " start) - (end-of-line))))) + (while (not (eobp)) + (unless first + (insert " ")) + (setq first nil) + (insert start) + (end-of-line) + (insert "?=") + (forward-line 1))))) + +(defun rfc2047-b-encode-region (b e) + "Encode the header contained in REGION with the B encoding." + (base64-encode-region b e t) + (goto-char (point-min)) + (while (not (eobp)) + (goto-char (min (point-max) (+ 64 (point)))) + (unless (eobp) + (insert "\n")))) (defun rfc2047-q-encode-region (b e) "Encode the header contained in REGION with the Q encoding." @@ -213,17 +226,23 @@ Should be called narrowed to the head of the message." (while alist (when (looking-at (caar alist)) (quoted-printable-encode-region b e nil (cdar alist)) - (subst-char-in-region (point-min) (point-max) ? ?_)) - (pop alist)))))) + (subst-char-in-region (point-min) (point-max) ? ?_) + (setq alist nil)) + (pop alist)) + (goto-char (point-min)) + (while (not (eobp)) + (goto-char (min (point-max) (+ 64 (point)))) + (search-backward "=" (- (point) 2) t) + (unless (eobp) + (insert "\n"))))))) ;;; ;;; Functions for decoding RFC2047 messages ;;; (defvar rfc2047-encoded-word-regexp - "=\\?\\([^][\000-\040()<>@,\;:\\\"/?.=]+\\)\\?\\(B\\|Q\\)\\?\\([!->@-~]+\\)\\?=") + "=\\?\\([^][\000-\040()<>@,\;:\\\"/?.=]+\\)\\?\\(B\\|Q\\)\\?\\([!->@-~ +]+\\)\\?=") -;;;###autoload (defun rfc2047-decode-region (start end) "Decode MIME-encoded words in region between START and END." (interactive "r") @@ -248,20 +267,23 @@ Should be called narrowed to the head of the message." (prog1 (match-string 0) (delete-region (match-beginning 0) (match-end 0))))) - (mm-decode-coding-region b e rfc2047-default-charset) + (when (mm-multibyte-p) + (mm-decode-coding-region b e rfc2047-default-charset)) (setq b (point))) - (mm-decode-coding-region b (point-max) rfc2047-default-charset))))) + (when (mm-multibyte-p) + (mm-decode-coding-region b (point-max) rfc2047-default-charset)))))) -;;;###autoload (defun rfc2047-decode-string (string) - "Decode the quoted-printable-encoded STRING and return the results." - (with-temp-buffer - (mm-enable-multibyte) - (insert string) - (inline - (rfc2047-decode-region (point-min) (point-max))) - (buffer-string))) - + "Decode the quoted-printable-encoded STRING and return the results." + (let ((m (mm-multibyte-p))) + (with-temp-buffer + (when m + (mm-enable-multibyte)) + (insert string) + (inline + (rfc2047-decode-region (point-min) (point-max))) + (buffer-string)))) + (defun rfc2047-parse-and-decode (word) "Decode WORD and return it if it is an encoded word. Return WORD if not." @@ -282,12 +304,12 @@ Valid ENCODINGs are \"B\" and \"Q\". If your Emacs implementation can't decode CHARSET, it returns nil." (let ((cs (mm-charset-to-coding-system charset))) (when cs + (when (eq cs 'ascii) + (setq cs rfc2047-default-charset)) (mm-decode-coding-string (cond ((equal "B" encoding) - (if (fboundp 'base64-decode-string) - (base64-decode-string string) - (base64-decode string))) + (base64-decode-string string)) ((equal "Q" encoding) (quoted-printable-decode-string (mm-replace-chars-in-string string ?_ ? )))