tm-ew-d.el

   1 ;;; tm-ew-d.el --- RFC 1522 based MIME encoded-word decoder for GNU Emacs
   2
   3 ;; Copyright (C) 1995,1996 Free Software Foundation, Inc.
   4
   5 ;; Author: ENAMI Tsugutomo <enami@sys.ptg.sony.co.jp>
   6 ;;         MORIOKA Tomohiko <morioka@jaist.ac.jp>
   7 ;; Maintainer: MORIOKA Tomohiko <morioka@jaist.ac.jp>
   8 ;; Created: 1995/10/03
   9 ;; Original: 1992/07/20 ENAMI Tsugutomo's `mime.el'.
  10 ;;      Renamed: 1993/06/03 to tiny-mime.el.
  11 ;;      Renamed: 1995/10/03 from tiny-mime.el. (split off encoder)
  12 ;; Version: $Revision: 7.29 $
  13 ;; Keywords: mail, news, MIME, RFC 1522, multilingual, encoded-word
  14
  15 ;; This file is part of tm (Tools for MIME).
  16
  17 ;; This program is free software; you can redistribute it and/or
  18 ;; modify it under the terms of the GNU General Public License as
  19 ;; published by the Free Software Foundation; either version 2, or (at
  20 ;; your option) any later version.
  21
  22 ;; This program is distributed in the hope that it will be useful, but
  23 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  24 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  25 ;; General Public License for more details.
  26
  27 ;; You should have received a copy of the GNU General Public License
  28 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  29 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  30 ;; Boston, MA 02111-1307, USA.
  31
  32 ;;; Code:
  33
  34 (require 'emu)
  35 (require 'std11)
  36 (require 'mel)
  37 (require 'tm-def)
  38
  39
  40 ;;; @ version
  41 ;;;
  42
  43 (defconst tm-ew-d/RCS-ID
  44   "$Id: tm-ew-d.el,v 7.29 1996/10/13 18:44:49 morioka Exp $")
  45 (defconst mime/eword-decoder-version (get-version-string tm-ew-d/RCS-ID))
  46
  47
  48 ;;; @ MIME encoded-word definition
  49 ;;;
  50
  51 (defconst mime/encoded-text-regexp "[!->@-~]+")
  52 (defconst mime/encoded-word-regexp (concat (regexp-quote "=?")
  53                                            "\\("
  54                                            mime/charset-regexp
  55                                            "\\)"
  56                                            (regexp-quote "?")
  57                                            "\\(B\\|Q\\)"
  58                                            (regexp-quote "?")
  59                                            "\\("
  60                                            mime/encoded-text-regexp
  61                                            "\\)"
  62                                            (regexp-quote "?=")))
  63
  64
  65 ;;; @ for string
  66 ;;;
  67
  68 (defun mime-eword/decode-string (string &optional must-unfold)
  69   "Decode MIME encoded-words in STRING.
  70
  71 STRING is unfolded before decoding.
  72
  73 If an encoded-word is broken or your emacs implementation can not
  74 decode the charset included in it, it is not decoded.
  75
  76 If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even
  77 if there are in decoded encoded-words (generated by bad manner MUA
  78 such as a version of Net$cape). [tm-ew-d.el]"
  79   (setq string (std11-unfold-string string))
  80   (let ((dest "")(ew nil)
  81         beg end)
  82     (while (and (string-match mime/encoded-word-regexp string)
  83                 (setq beg (match-beginning 0)
  84                       end (match-end 0))
  85                 )
  86       (if (> beg 0)
  87           (if (not
  88                (and (eq ew t)
  89                     (string-match "^[ \t]+$" (substring string 0 beg))
  90                     ))
  91               (setq dest (concat dest (substring string 0 beg)))
  92             )
  93         )
  94       (setq dest
  95             (concat dest
  96                     (mime/decode-encoded-word
  97                      (substring string beg end) must-unfold)
  98                     ))
  99       (setq string (substring string end))
 100       (setq ew t)
 101       )
 102     (concat dest string)
 103     ))
 104
 105
 106 ;;; @ for region
 107 ;;;
 108
 109 (defun mime-eword/decode-region (start end &optional unfolding must-unfold)
 110   "Decode MIME encoded-words in region between START and END.
 111
 112 If UNFOLDING is not nil, it unfolds before decoding.
 113
 114 If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even
 115 if there are in decoded encoded-words (generated by bad manner MUA
 116 such as a version of Net$cape). [tm-ew-d.el]"
 117   (interactive "*r")
 118   (save-excursion
 119     (save-restriction
 120       (narrow-to-region start end)
 121       (if unfolding
 122           (mime/unfolding)
 123         )
 124       (goto-char (point-min))
 125       (while (re-search-forward
 126               (concat (regexp-quote "?=") "\\s +" (regexp-quote "=?"))
 127               nil t)
 128         (replace-match "?==?")
 129         )
 130       (goto-char (point-min))
 131       (let (charset encoding text)
 132         (while (re-search-forward mime/encoded-word-regexp nil t)
 133           (insert (mime/decode-encoded-word
 134                    (prog1
 135                        (buffer-substring (match-beginning 0) (match-end 0))
 136                      (delete-region (match-beginning 0) (match-end 0))
 137                      ) must-unfold))
 138           ))
 139       )))
 140
 141
 142 ;;; @ for message header
 143 ;;;
 144
 145 (defun mime/decode-message-header ()
 146   "Decode MIME encoded-words in message header. [tm-ew-d.el]"
 147   (interactive "*")
 148   (save-excursion
 149     (save-restriction
 150       (narrow-to-region (goto-char (point-min))
 151                         (progn (re-search-forward "^$" nil t) (point)))
 152       (mime-eword/decode-region (point-min) (point-max) t)
 153       )))
 154
 155 (defun mime/unfolding ()
 156   (goto-char (point-min))
 157   (let (field beg end)
 158     (while (re-search-forward std11-field-head-regexp nil t)
 159       (setq beg (match-beginning 0)
 160             end (std11-field-end))
 161       (setq field (buffer-substring beg end))
 162       (if (string-match mime/encoded-word-regexp field)
 163           (save-restriction
 164             (narrow-to-region (goto-char beg) end)
 165             (while (re-search-forward "\n[ \t]+" nil t)
 166               (replace-match " ")
 167               )
 168             (goto-char (point-max))
 169             ))
 170       )))
 171
 172
 173 ;;; @ encoded-word decoder
 174 ;;;
 175
 176 (defun mime/decode-encoded-word (word &optional must-unfold)
 177   "Decode WORD if it is an encoded-word.
 178
 179 If your emacs implementation can not decode the charset of WORD, it
 180 returns WORD.  Similarly the encoded-word is broken, it returns WORD.
 181
 182 If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even
 183 if there are in decoded encoded-word (generated by bad manner MUA such
 184 as a version of Net$cape). [tm-ew-d.el]"
 185   (or (if (string-match mime/encoded-word-regexp word)
 186           (let ((charset
 187                  (substring word (match-beginning 1) (match-end 1))
 188                  )
 189                 (encoding
 190                  (upcase
 191                   (substring word (match-beginning 2) (match-end 2))
 192                   ))
 193                 (text
 194                  (substring word (match-beginning 3) (match-end 3))
 195                  ))
 196             (mime/decode-encoded-text charset encoding text must-unfold)
 197             ))
 198       word))
 199
 200
 201 ;;; @ encoded-text decoder
 202 ;;;
 203
 204 (defun mime/decode-encoded-text (charset encoding string &optional must-unfold)
 205   "Decode STRING as an encoded-text.
 206
 207 If your emacs implementation can not decode CHARSET, it returns nil.
 208
 209 If ENCODING is not \"B\" or \"Q\", it occurs error.
 210 So you should write error-handling code if you don't want break by errors.
 211
 212 If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even
 213 if there are in decoded encoded-text (generated by bad manner MUA such
 214 as a version of Net$cape). [tm-ew-d.el]"
 215   (let ((cs (mime-charset-to-coding-system charset)))
 216     (if cs
 217         (let ((dest
 218                (cond ((string-equal "B" encoding)
 219                       (base64-decode-string string))
 220                      ((string-equal "Q" encoding)
 221                       (q-encoding-decode-string string))
 222                      (t (message "unknown encoding %s" encoding)
 223                         nil))))
 224           (if dest
 225               (progn
 226                 (setq dest (decode-coding-string dest cs))
 227                 (if must-unfold
 228                     (mapconcat (function
 229                                 (lambda (chr)
 230                                   (if (eq chr ?\n)
 231                                       ""
 232                                     (char-to-string chr)
 233                                     )
 234                                   ))
 235                                (std11-unfold-string dest)
 236                                "")
 237                   dest)
 238                 ))))))
 239
 240
 241 ;;; @ end
 242 ;;;
 243
 244 (provide 'tm-ew-d)
 245
 246 ;;; tm-ew-d.el ends here