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: 1993/6/3 (1995/10/3 obsolete tiny-mime.el)
   9 ;; Version: $Revision: 7.21 $
  10 ;; Keywords: mail, news, MIME, RFC 1522, multilingual, encoded-word
  11
  12 ;; This file is part of tm (Tools for MIME).
  13
  14 ;; This program is free software; you can redistribute it and/or
  15 ;; modify it under the terms of the GNU General Public License as
  16 ;; published by the Free Software Foundation; either version 2, or (at
  17 ;; your option) any later version.
  18
  19 ;; This program is distributed in the hope that it will be useful, but
  20 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  22 ;; General Public License for more details.
  23
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with this program; see the file COPYING.  If not, write to
  26 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  27 ;; Boston, MA 02111-1307, USA.
  28
  29 ;;; Code:
  30
  31 (require 'emu)
  32 (require 'tl-822)
  33 (require 'mel)
  34 (require 'tm-def)
  35
  36
  37 ;;; @ version
  38 ;;;
  39
  40 (defconst tm-ew-d/RCS-ID
  41   "$Id: tm-ew-d.el,v 7.21 1996/08/17 02:41:20 morioka Exp $")
  42 (defconst mime/eword-decoder-version (get-version-string tm-ew-d/RCS-ID))
  43
  44
  45 ;;; @ MIME encoded-word definition
  46 ;;;
  47
  48 (defconst mime/encoded-text-regexp "[!->@-~]+")
  49 (defconst mime/encoded-word-regexp (concat (regexp-quote "=?")
  50                                            "\\("
  51                                            mime/charset-regexp
  52                                            "\\)"
  53                                            (regexp-quote "?")
  54                                            "\\(B\\|Q\\)"
  55                                            (regexp-quote "?")
  56                                            "\\("
  57                                            mime/encoded-text-regexp
  58                                            "\\)"
  59                                            (regexp-quote "?=")))
  60
  61
  62 ;;; @ for string
  63 ;;;
  64
  65 (defun mime-eword/decode-string (str &optional unfolding)
  66   (setq str (rfc822/unfolding-string str))
  67   (let ((dest "")(ew nil)
  68         beg end)
  69     (while (and (string-match mime/encoded-word-regexp str)
  70                 (setq beg (match-beginning 0)
  71                       end (match-end 0))
  72                 )
  73       (if (> beg 0)
  74           (if (not
  75                (and (eq ew t)
  76                     (string-match "^[ \t]+$" (substring str 0 beg))
  77                     ))
  78               (setq dest (concat dest (substring str 0 beg)))
  79             )
  80         )
  81       (setq dest
  82             (concat dest
  83                     (mime/decode-encoded-word
  84                      (substring str beg end) unfolding)
  85                     ))
  86       (setq str (substring str end))
  87       (setq ew t)
  88       )
  89     (concat dest str)
  90     ))
  91
  92
  93 ;;; @ for region
  94 ;;;
  95
  96 (defun mime-eword/decode-region (beg end &optional unfolding must-unfold)
  97   "Decode MIME encoded-words in region between BEG and END.
  98 If UNFOLDING is not nil, it unfolds before decoding.
  99 If MUST-UNFOLD is not nil, it unfolds encoded results. [tm-ew-d.el]"
 100   (interactive "*r")
 101   (save-excursion
 102     (save-restriction
 103       (narrow-to-region beg end)
 104       (if unfolding
 105           (mime/unfolding)
 106         )
 107       (goto-char (point-min))
 108       (while (re-search-forward
 109               (concat (regexp-quote "?=") "\\s +" (regexp-quote "=?"))
 110               nil t)
 111         (replace-match "?==?")
 112         )
 113       (goto-char (point-min))
 114       (let (charset encoding text)
 115         (while (re-search-forward mime/encoded-word-regexp nil t)
 116           (insert (mime/decode-encoded-word
 117                    (prog1
 118                        (buffer-substring (match-beginning 0) (match-end 0))
 119                      (delete-region (match-beginning 0) (match-end 0))
 120                      ) must-unfold))
 121           ))
 122       )))
 123
 124
 125 ;;; @ for message header
 126 ;;;
 127
 128 (defun mime/decode-message-header ()
 129   "Decode MIME encoded-words in message header. [tm-ew-d.el]"
 130   (interactive "*")
 131   (save-excursion
 132     (save-restriction
 133       (narrow-to-region (goto-char (point-min))
 134                         (progn (re-search-forward "^$" nil t) (point)))
 135       (mime-eword/decode-region (point-min) (point-max) t)
 136       )))
 137
 138 (defun mime/unfolding ()
 139   (goto-char (point-min))
 140   (let (field beg end)
 141     (while (re-search-forward rfc822/field-top-regexp nil t)
 142       (setq beg (match-beginning 0))
 143       (setq end (rfc822/field-end))
 144       (setq field (buffer-substring beg end))
 145       (if (string-match mime/encoded-word-regexp field)
 146           (save-restriction
 147             (narrow-to-region (goto-char beg) end)
 148             (while (re-search-forward "\n[ \t]+" nil t)
 149               (replace-match " ")
 150               )
 151             (goto-char (point-max))
 152             ))
 153       )))
 154
 155
 156 ;;; @ encoded-word decoder
 157 ;;;
 158
 159 (defun mime/decode-encoded-word (word &optional unfolding)
 160   (or (if (string-match mime/encoded-word-regexp word)
 161           (let ((charset
 162                  (substring word (match-beginning 1) (match-end 1))
 163                  )
 164                 (encoding
 165                  (upcase
 166                   (substring word (match-beginning 2) (match-end 2))
 167                   ))
 168                 (text
 169                  (substring word (match-beginning 3) (match-end 3))
 170                  ))
 171             (mime/decode-encoded-text charset encoding text unfolding)
 172             ))
 173       word))
 174
 175
 176 ;;; @ encoded-text decoder
 177 ;;;
 178
 179 (defun mime/decode-encoded-text (charset encoding str &optional unfolding)
 180   (let ((cs (mime-charset-to-coding-system charset)))
 181     (if cs
 182         (let ((dest
 183                (cond ((string-equal "B" encoding)
 184                       (base64-decode-string str))
 185                      ((string-equal "Q" encoding)
 186                       (q-encoding-decode-string str))
 187                      (t (message "unknown encoding %s" encoding)
 188                         nil))))
 189           (if dest
 190               (progn
 191                 (setq dest (decode-coding-string dest cs))
 192                 (if unfolding
 193                     (rfc822/unfolding-string dest)
 194                   dest)
 195                 ))))))
 196
 197
 198 ;;; @ end
 199 ;;;
 200
 201 (provide 'tm-ew-d)
 202
 203 ;;; tm-ew-d.el ends here