X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=tm-ew-d.el;h=57a7a4f7d7f2d13a3c68b2f7a7dd128e5edc6f48;hb=b77b17617ad6e2d752ffa07cc4232a54c6ebae81;hp=d7a5145116a7ad64f46ba2c06624ea54614cbbe6;hpb=34f7fd72edf87445ea4ff9fbb8776f99ea914fa0;p=elisp%2Ftm.git diff --git a/tm-ew-d.el b/tm-ew-d.el index d7a5145..57a7a4f 100644 --- a/tm-ew-d.el +++ b/tm-ew-d.el @@ -1,47 +1,48 @@ -;;; -;;; tm-ew-d.el --- RFC 1522 based multilingual MIME message header -;;; decoder for GNU Emacs -;;; -;;; Copyright (C) 1995 Free Software Foundation, Inc. -;;; Copyright (C) 1992 ENAMI Tsugutomo -;;; Copyright (C) 1993 .. 1996 MORIOKA Tomohiko -;;; -;;; Author: ENAMI Tsugutomo -;;; MORIOKA Tomohiko -;;; Maintainer: MORIOKA Tomohiko -;;; Created: 1993/6/3 (1995/10/3 obsolete tiny-mime.el) -;;; Version: $Revision: 7.8 $ -;;; Keywords: mail, news, MIME, RFC 1522, multilingual, encoded-word -;;; -;;; This file is part of tm (Tools for MIME). -;;; -;;; This program is free software; you can redistribute it and/or -;;; modify it under the terms of the GNU General Public License as -;;; published by the Free Software Foundation; either version 2, or -;;; (at your option) any later version. -;;; -;;; This program is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;;; General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with This program. If not, write to the Free Software -;;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. -;;; +;;; tm-ew-d.el --- RFC 2047 based encoded-word decoder for GNU Emacs + +;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc. + +;; Author: ENAMI Tsugutomo +;; MORIOKA Tomohiko +;; Maintainer: MORIOKA Tomohiko +;; 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.40 $ +;; Keywords: encoded-word, MIME, multilingual, header, mail, news + +;; This file is part of tm (Tools for MIME). + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2, or (at +;; your option) any later version. + +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; 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.8 1996/01/25 06:36:44 morioka Exp $") + "$Id: tm-ew-d.el,v 7.40 1997/03/06 17:53:51 morioka Exp $") (defconst mime/eword-decoder-version (get-version-string tm-ew-d/RCS-ID)) @@ -65,58 +66,77 @@ ;;; @ for string ;;; -(defun mime-eword/decode-string (str) - (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)) - )) - (setq str (substring str end)) + (setq dest + (concat dest + (mime/decode-encoded-word + (substring string beg end) must-unfold) + )) + (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) +(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 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 + (insert (mime/decode-encoded-word (prog1 (buffer-substring (match-beginning 0) (match-end 0)) (delete-region (match-beginning 0) (match-end 0)) - ) - )) + ) must-unfold)) )) ))) @@ -125,6 +145,7 @@ ;;; (defun mime/decode-message-header () + "Decode MIME encoded-words in message header. [tm-ew-d.el]" (interactive "*") (save-excursion (save-restriction @@ -136,16 +157,17 @@ (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)) )) ))) @@ -154,12 +176,19 @@ ;;; @ encoded-word decoder ;;; -(defun mime/decode-encoded-word (word) +(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 - (upcase - (substring word (match-beginning 1) (match-end 1)) - )) + (substring word (match-beginning 1) (match-end 1)) + ) (encoding (upcase (substring word (match-beginning 2) (match-end 2)) @@ -167,28 +196,70 @@ (text (substring word (match-beginning 3) (match-end 3)) )) - (mime/decode-encoded-text charset encoding text) - )) + (condition-case err + (mime/decode-encoded-text charset encoding text must-unfold) + (error + (and (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) - (let ((dest - (cond ((string= "B" encoding) - (base64-decode-string str)) - ((string= "Q" encoding) - (q-encoding-decode-string str)) - (t (message "unknown encoding %s" encoding) - nil)))) - (if dest - (mime/convert-string-to-emacs charset dest) - ))) +(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) + (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 must-unfold + (mapconcat (function + (lambda (chr) + (cond + ((eq chr ?\n) "") + ((eq chr ?\t) " ") + (t (char-to-string chr))) + )) + (std11-unfold-string dest) + "") + dest) + )))))) ;;; @ end ;;; (provide 'tm-ew-d) + +;;; tm-ew-d.el ends here