X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=tm-ew-d.el;h=9eec4d7649c9001dabcc4365f41b75443ff6671c;hb=86824724a2d5325e296ee93a1abb3952d2320a20;hp=8d6150faf39e09ebbedc75ac308003b50ec3d08e;hpb=bd7fea6f690f502e3ba2f627bd0b188d1b64af7c;p=elisp%2Ftm.git diff --git a/tm-ew-d.el b/tm-ew-d.el index 8d6150f..9eec4d7 100644 --- a/tm-ew-d.el +++ b/tm-ew-d.el @@ -1,38 +1,38 @@ -;;; -;;; 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,1994,1995 MORIOKA Tomohiko -;;; -;;; Author: ENAMI Tsugutomo -;;; MORIOKA Tomohiko -;;; Maintainer: MORIOKA Tomohiko -;;; Created: 1993/6/3 (1995/10/3 obsolete tiny-mime.el) -;;; Version: $Revision: 7.6 $ -;;; 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 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.34 $ +;; 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) @@ -41,7 +41,7 @@ ;;; (defconst tm-ew-d/RCS-ID - "$Id: tm-ew-d.el,v 7.6 1995/12/06 08:15:51 morioka Exp $") + "$Id: tm-ew-d.el,v 7.34 1996/12/04 04:49:14 morioka Exp $") (defconst mime/eword-decoder-version (get-version-string tm-ew-d/RCS-ID)) @@ -65,54 +65,74 @@ ;;; @ 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 (setq beg (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= (substring str 0 beg) " "))) - (setq dest (concat dest (substring str 0 beg) - )) + (if (not + (and (eq ew t) + (string-match "^[ \t]+$" (substring string 0 beg)) + )) + (setq dest (concat dest (substring string 0 beg))) ) ) - (setq end (match-end 0)) - (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) + (while (re-search-forward "\\?=\\(\n*\\s +\\)+=\\?" nil t) (replace-match "?==?") ) (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)) )) ))) @@ -121,6 +141,7 @@ ;;; (defun mime/decode-message-header () + "Decode MIME encoded-words in message header. [tm-ew-d.el]" (interactive "*") (save-excursion (save-restriction @@ -132,16 +153,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)) )) ))) @@ -150,12 +172,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)) @@ -163,7 +192,9 @@ (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 nil)) )) word)) @@ -171,20 +202,48 @@ ;;; @ 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 ((and (string-equal "B" encoding) + (string-match mime/B-encoded-text-regexp string)) + (base64-decode-string string)) + ((and (string-equal "Q" encoding) + (string-match mime/Q-encoded-text-regexp string)) + (q-encoding-decode-string string)) + (t (message "Invalid encoded-word %s" encoding) + nil)))) + (if dest + (progn + (setq dest (decode-coding-string dest cs)) + (if must-unfold + (mapconcat (function + (lambda (chr) + (if (eq chr ?\n) + "" + (char-to-string chr) + ) + )) + (std11-unfold-string dest) + "") + dest) + )))))) ;;; @ end ;;; (provide 'tm-ew-d) + +;;; tm-ew-d.el ends here