X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=sidebyside;f=tm-ew-d.el;h=9ebf1255d7155a4eeba5b3288b728b810b24b427;hb=6c79137304c0b1d6e94fe8cb3a38f3aad50e0195;hp=271180b5f14892197fdeb80ba8cd678dd4793c6c;hpb=64f6da47517dd7323f789a3a6afa5ce5221b08cb;p=elisp%2Ftm.git diff --git a/tm-ew-d.el b/tm-ew-d.el index 271180b..9ebf125 100644 --- a/tm-ew-d.el +++ b/tm-ew-d.el @@ -1,13 +1,16 @@ -;;; tm-ew-d.el --- RFC 1522 based MIME encoded-word decoder for GNU Emacs +;;; tm-ew-d.el --- RFC 2047 based encoded-word decoder for GNU Emacs -;; Copyright (C) 1995,1996 Free Software Foundation, Inc. +;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc. ;; Author: ENAMI Tsugutomo ;; MORIOKA Tomohiko ;; Maintainer: MORIOKA Tomohiko -;; Created: 1993/6/3 (1995/10/3 obsolete tiny-mime.el) -;; Version: $Revision: 7.21 $ -;; Keywords: mail, news, MIME, RFC 1522, multilingual, encoded-word +;; Created: 1995/10/03 +;; Original: 1992/07/20 ENAMI Tsugutomo's `mime.el'. +;; Renamed: 1993/06/03 to tiny-mime.el. +;; Renamed: 1995/10/03 from tiny-mime.el. (split off encoder) +;; Version: $Revision: 7.39 $ +;; Keywords: encoded-word, MIME, multilingual, header, mail, news ;; This file is part of tm (Tools for MIME). @@ -22,23 +25,24 @@ ;; General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with this program; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;;; Code: (require 'emu) -(require 'tl-822) +(require 'std11) (require 'mel) (require 'tm-def) +(require 'tl-str) ;;; @ version ;;; (defconst tm-ew-d/RCS-ID - "$Id: tm-ew-d.el,v 7.21 1996/08/17 02:41:20 morioka Exp $") + "$Id: tm-ew-d.el,v 7.39 1997/01/21 06:17:18 shuhei-k Exp $") (defconst mime/eword-decoder-version (get-version-string tm-ew-d/RCS-ID)) @@ -62,55 +66,70 @@ ;;; @ for string ;;; -(defun mime-eword/decode-string (str &optional unfolding) - (setq str (rfc822/unfolding-string str)) +(defun mime-eword/decode-string (string &optional must-unfold) + "Decode MIME encoded-words in STRING. + +STRING is unfolded before decoding. + +If an encoded-word is broken or your emacs implementation can not +decode the charset included in it, it is not decoded. + +If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even +if there are in decoded encoded-words (generated by bad manner MUA +such as a version of Net$cape). [tm-ew-d.el]" + (setq string (std11-unfold-string string)) (let ((dest "")(ew nil) beg end) - (while (and (string-match mime/encoded-word-regexp str) + (while (and (string-match mime/encoded-word-regexp string) (setq beg (match-beginning 0) end (match-end 0)) ) (if (> beg 0) (if (not (and (eq ew t) - (string-match "^[ \t]+$" (substring str 0 beg)) + (string-match "^[ \t]+$" (substring string 0 beg)) )) - (setq dest (concat dest (substring str 0 beg))) + (setq dest (concat dest (substring string 0 beg))) ) ) (setq dest (concat dest (mime/decode-encoded-word - (substring str beg end) unfolding) + (substring string beg end) must-unfold) )) - (setq str (substring str end)) + (setq string (substring string end)) (setq ew t) ) - (concat dest str) + (concat dest string) )) ;;; @ for region ;;; -(defun mime-eword/decode-region (beg end &optional unfolding must-unfold) - "Decode MIME encoded-words in region between BEG and END. +(defun mime-eword/decode-region (start end &optional unfolding must-unfold) + "Decode MIME encoded-words in region between START and END. + If UNFOLDING is not nil, it unfolds before decoding. -If MUST-UNFOLD is not nil, it unfolds encoded results. [tm-ew-d.el]" + +If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even +if there are in decoded encoded-words (generated by bad manner MUA +such as a version of Net$cape). [tm-ew-d.el]" (interactive "*r") (save-excursion (save-restriction - (narrow-to-region beg end) + (narrow-to-region start end) (if unfolding (mime/unfolding) ) (goto-char (point-min)) - (while (re-search-forward - (concat (regexp-quote "?=") "\\s +" (regexp-quote "=?")) - nil t) - (replace-match "?==?") + (while (re-search-forward (concat "\\(" mime/encoded-word-regexp "\\)" + "\\(\n?[ \t]\\)+" + "\\(" mime/encoded-word-regexp "\\)") + nil t) + (replace-match "\\1\\6") + (goto-char (point-min)) ) - (goto-char (point-min)) (let (charset encoding text) (while (re-search-forward mime/encoded-word-regexp nil t) (insert (mime/decode-encoded-word @@ -138,16 +157,17 @@ If MUST-UNFOLD is not nil, it unfolds encoded results. [tm-ew-d.el]" (defun mime/unfolding () (goto-char (point-min)) (let (field beg end) - (while (re-search-forward rfc822/field-top-regexp nil t) - (setq beg (match-beginning 0)) - (setq end (rfc822/field-end)) + (while (re-search-forward std11-field-head-regexp nil t) + (setq beg (match-beginning 0) + end (std11-field-end)) (setq field (buffer-substring beg end)) (if (string-match mime/encoded-word-regexp field) - (save-restriction - (narrow-to-region (goto-char beg) end) - (while (re-search-forward "\n[ \t]+" nil t) - (replace-match " ") - ) + (save-restriction + (narrow-to-region (goto-char beg) end) + (while (re-search-forward "\n\\([ \t]\\)" nil t) + (replace-match + (match-string 1)) + ) (goto-char (point-max)) )) ))) @@ -156,7 +176,15 @@ If MUST-UNFOLD is not nil, it unfolds encoded results. [tm-ew-d.el]" ;;; @ encoded-word decoder ;;; -(defun mime/decode-encoded-word (word &optional unfolding) +(defun mime/decode-encoded-word (word &optional must-unfold) + "Decode WORD if it is an encoded-word. + +If your emacs implementation can not decode the charset of WORD, it +returns WORD. Similarly the encoded-word is broken, it returns WORD. + +If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even +if there are in decoded encoded-word (generated by bad manner MUA such +as a version of Net$cape). [tm-ew-d.el]" (or (if (string-match mime/encoded-word-regexp word) (let ((charset (substring word (match-beginning 1) (match-end 1)) @@ -168,29 +196,63 @@ If MUST-UNFOLD is not nil, it unfolds encoded results. [tm-ew-d.el]" (text (substring word (match-beginning 3) (match-end 3)) )) - (mime/decode-encoded-text charset encoding text unfolding) - )) + (condition-case err + (mime/decode-encoded-text charset encoding text must-unfold) + (error + (and (tl:add-text-properties 0 (length word) + (and tm:warning-face + (list 'face tm:warning-face)) + word) + word))) + )) word)) ;;; @ encoded-text decoder ;;; -(defun mime/decode-encoded-text (charset encoding str &optional unfolding) +(defun mime/decode-encoded-text (charset encoding string &optional must-unfold) + "Decode STRING as an encoded-text. + +If your emacs implementation can not decode CHARSET, it returns nil. + +If ENCODING is not \"B\" or \"Q\", it occurs error. +So you should write error-handling code if you don't want break by errors. + +If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even +if there are in decoded encoded-text (generated by bad manner MUA such +as a version of Net$cape). [tm-ew-d.el]" (let ((cs (mime-charset-to-coding-system charset))) (if cs (let ((dest - (cond ((string-equal "B" encoding) - (base64-decode-string str)) - ((string-equal "Q" encoding) - (q-encoding-decode-string str)) - (t (message "unknown encoding %s" encoding) - nil)))) + (cond + ((string-equal "B" encoding) + (if (and (string-match mime/B-encoded-text-regexp string) + (string-equal string (match-string 0 string))) + (base64-decode-string string) + (error "Invalid encoded-text %s" string))) + ((string-equal "Q" encoding) + (if (and (string-match mime/Q-encoded-text-regexp string) + (string-equal string (match-string 0 string))) + (q-encoding-decode-string string) + (error "Invalid encoded-text %s" string))) + (t + (error "Invalid encoding %s" encoding) + ))) + ) (if dest (progn (setq dest (decode-coding-string dest cs)) - (if unfolding - (rfc822/unfolding-string dest) + (if must-unfold + (mapconcat (function + (lambda (chr) + (cond + ((eq chr ?\n) "") + ((eq chr ?\t) " ") + (t (char-to-string chr))) + )) + (std11-unfold-string dest) + "") dest) ))))))