tm-ew-d.el

   1 ;;;
   2 ;;; tm-ew-d.el --- RFC 1522 based multilingual MIME message header
   3 ;;;                decoder for GNU Emacs
   4 ;;;
   5 ;;; Copyright (C) 1995 Free Software Foundation, Inc.
   6 ;;; Copyright (C) 1992 ENAMI Tsugutomo
   7 ;;; Copyright (C) 1993 .. 1996 MORIOKA Tomohiko
   8 ;;;
   9 ;;; Author: ENAMI Tsugutomo <enami@sys.ptg.sony.co.jp>
  10 ;;;         MORIOKA Tomohiko <morioka@jaist.ac.jp>
  11 ;;; Maintainer: MORIOKA Tomohiko <morioka@jaist.ac.jp>
  12 ;;; Created: 1993/6/3 (1995/10/3 obsolete tiny-mime.el)
  13 ;;; Version: $Revision: 7.18 $
  14 ;;; Keywords: mail, news, MIME, RFC 1522, multilingual, encoded-word
  15 ;;;
  16 ;;; This file is part of tm (Tools for MIME).
  17 ;;;
  18 ;;; This program is free software; you can redistribute it and/or
  19 ;;; modify it under the terms of the GNU General Public License as
  20 ;;; published by the Free Software Foundation; either version 2, or
  21 ;;; (at your option) any later version.
  22 ;;;
  23 ;;; This program is distributed in the hope that it will be useful,
  24 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  25 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  26 ;;; General Public License for more details.
  27 ;;;
  28 ;;; You should have received a copy of the GNU General Public License
  29 ;;; along with This program.  If not, write to the Free Software
  30 ;;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  31 ;;;
  32 ;;; Code:
  33
  34 (require 'emu)
  35 (require 'tl-822)
  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.18 1996/08/07 15:50:44 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 (str &optional unfolding)
  69   (setq str (rfc822/unfolding-string str))
  70   (let ((dest "")(ew nil)
  71         beg end)
  72     (while (and (string-match mime/encoded-word-regexp str)
  73                 (setq beg (match-beginning 0)
  74                       end (match-end 0))
  75                 )
  76       (if (> beg 0)
  77           (if (not
  78                (and (eq ew t)
  79                     (string-match "^[ \t]+$" (substring str 0 beg))
  80                     ))
  81               (setq dest (concat dest (substring str 0 beg)))
  82             )
  83         )
  84       (setq dest
  85             (concat dest
  86                     (mime/decode-encoded-word
  87                      (substring str beg end) unfolding)
  88                     ))
  89       (setq str (substring str end))
  90       (setq ew t)
  91       )
  92     (concat dest str)
  93     ))
  94
  95
  96 ;;; @ for region
  97 ;;;
  98
  99 (defun mime-eword/decode-region (beg end &optional unfolding must-unfold)
 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   (interactive "*")
 130   (save-excursion
 131     (save-restriction
 132       (narrow-to-region (goto-char (point-min))
 133                         (progn (re-search-forward "^$" nil t) (point)))
 134       (mime-eword/decode-region (point-min) (point-max) t)
 135       )))
 136
 137 (defun mime/unfolding ()
 138   (goto-char (point-min))
 139   (let (field beg end)
 140     (while (re-search-forward rfc822/field-top-regexp nil t)
 141       (setq beg (match-beginning 0))
 142       (setq end (rfc822/field-end))
 143       (setq field (buffer-substring beg end))
 144       (if (string-match mime/encoded-word-regexp field)
 145           (save-restriction
 146             (narrow-to-region (goto-char beg) end)
 147             (while (re-search-forward "\n[ \t]+" nil t)
 148               (replace-match " ")
 149               )
 150             (goto-char (point-max))
 151             ))
 152       )))
 153
 154
 155 ;;; @ encoded-word decoder
 156 ;;;
 157
 158 (defun mime/decode-encoded-word (word &optional unfolding)
 159   (or (if (string-match mime/encoded-word-regexp word)
 160           (let ((charset
 161                  (substring word (match-beginning 1) (match-end 1))
 162                  )
 163                 (encoding
 164                  (upcase
 165                   (substring word (match-beginning 2) (match-end 2))
 166                   ))
 167                 (text
 168                  (substring word (match-beginning 3) (match-end 3))
 169                  ))
 170             (mime/decode-encoded-text charset encoding text unfolding)
 171             ))
 172       word))
 173
 174
 175 ;;; @ encoded-text decoder
 176 ;;;
 177
 178 (defun mime/decode-encoded-text (charset encoding str &optional unfolding)
 179   (let ((dest
 180          (cond ((string-equal "B" encoding)
 181                 (base64-decode-string str))
 182                ((string-equal "Q" encoding)
 183                 (q-encoding-decode-string str))
 184                (t (message "unknown encoding %s" encoding)
 185                   nil))))
 186     (if dest
 187         (progn
 188           (setq dest (decode-mime-charset-string dest charset))
 189           (if unfolding
 190               (rfc822/unfolding-string dest)
 191             dest)
 192           ))))
 193
 194
 195 ;;; @ end
 196 ;;;
 197
 198 (provide 'tm-ew-d)
 199
 200 ;;; tm-ew-d.el ends here