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,1994,1995 MORIOKA Tomohiko
   8 ;;;
   9 ;;; Author: ENAMI Tsugutomo <enami@sys.ptg.sony.co.jp>
  10 ;;;         MORIOKA Tomohiko <morioka@jaist.ac.jp>
  11 ;;; Keywords: mail, news, MIME, RFC 1522, multilingual, encoded-word
  12 ;;;
  13
  14 (require 'emu)
  15 (require 'tl-822)
  16 (require 'mel)
  17 (require 'tm-def)
  18
  19
  20 ;;; @ version
  21 ;;;
  22
  23 (defconst tm-ew-d/RCS-ID
  24   "$Id: tm-ew-d.el,v 7.5 1995/10/18 11:18:03 morioka Exp $")
  25 (defconst mime/eword-decoder-version (get-version-string tm-ew-d/RCS-ID))
  26
  27
  28 ;;; @ MIME encoded-word definition
  29 ;;;
  30
  31 (defconst mime/encoded-text-regexp "[!->@-~]+")
  32 (defconst mime/encoded-word-regexp (concat (regexp-quote "=?")
  33                                            "\\("
  34                                            mime/charset-regexp
  35                                            "\\)"
  36                                            (regexp-quote "?")
  37                                            "\\(B\\|Q\\)"
  38                                            (regexp-quote "?")
  39                                            "\\("
  40                                            mime/encoded-text-regexp
  41                                            "\\)"
  42                                            (regexp-quote "?=")))
  43
  44
  45 ;;; @ for string
  46 ;;;
  47
  48 (defun mime-eword/decode-string (str)
  49   (setq str (rfc822/unfolding-string str))
  50   (let ((dest "")(ew nil)
  51         beg end)
  52     (while (setq beg (string-match mime/encoded-word-regexp str))
  53       (if (> beg 0)
  54           (if (not (and (eq ew t) (string= (substring str 0 beg) " ")))
  55               (setq dest (concat dest (substring str 0 beg)
  56                                  ))
  57             )
  58         )
  59       (setq end (match-end 0))
  60       (setq dest (concat dest
  61                          (mime/decode-encoded-word (substring str beg end))
  62                          ))
  63       (setq str (substring str end))
  64       (setq ew t)
  65       )
  66     (concat dest str)
  67     ))
  68
  69
  70 ;;; @ for region
  71 ;;;
  72
  73 (defun mime-eword/decode-region (beg end &optional unfolding)
  74   (interactive "*r")
  75   (save-excursion
  76     (save-restriction
  77       (narrow-to-region beg end)
  78       (if unfolding
  79           (mime/unfolding)
  80         )
  81       (goto-char (point-min))
  82       (while (re-search-forward
  83               (concat (regexp-quote "?=") "\\s +" (regexp-quote "=?"))
  84               nil t)
  85         (replace-match "?==?")
  86         )
  87       (goto-char (point-min))
  88       (let (charset encoding text)
  89         (while (re-search-forward mime/encoded-word-regexp nil t)
  90           (insert (mime/decode-encoded-word
  91                    (prog1
  92                        (buffer-substring (match-beginning 0) (match-end 0))
  93                      (delete-region (match-beginning 0) (match-end 0))
  94                      )
  95                    ))
  96           ))
  97       )))
  98
  99
 100 ;;; @ for message header
 101 ;;;
 102
 103 (defun mime/decode-message-header ()
 104   (interactive "*")
 105   (save-excursion
 106     (save-restriction
 107       (narrow-to-region (goto-char (point-min))
 108                         (progn (re-search-forward "^$" nil t) (point)))
 109       (mime-eword/decode-region (point-min) (point-max) t)
 110       )))
 111
 112 (defun mime/unfolding ()
 113   (goto-char (point-min))
 114   (let (field beg end)
 115     (while (re-search-forward rfc822/field-top-regexp nil t)
 116       (setq beg (match-beginning 0))
 117       (setq end (rfc822/field-end))
 118       (setq field (buffer-substring beg end))
 119       (if (string-match mime/encoded-word-regexp field)
 120           (save-restriction
 121             (narrow-to-region (goto-char beg) end)
 122             (while (re-search-forward "\n[ \t]+" nil t)
 123               (replace-match " ")
 124               )
 125             (goto-char (point-max))
 126             ))
 127       )))
 128
 129
 130 ;;; @ encoded-word decoder
 131 ;;;
 132
 133 (defun mime/decode-encoded-word (word)
 134   (or (if (string-match mime/encoded-word-regexp word)
 135           (let ((charset
 136                  (upcase
 137                   (substring word (match-beginning 1) (match-end 1))
 138                   ))
 139                 (encoding
 140                  (upcase
 141                   (substring word (match-beginning 2) (match-end 2))
 142                   ))
 143                 (text
 144                  (substring word (match-beginning 3) (match-end 3))
 145                  ))
 146             (mime/decode-encoded-text charset encoding text)
 147             ))
 148       word))
 149
 150
 151 ;;; @ encoded-text decoder
 152 ;;;
 153
 154 (defun mime/decode-encoded-text (charset encoding str)
 155   (let ((dest
 156          (cond ((string= "B" encoding)
 157                 (base64-decode-string str))
 158                ((string= "Q" encoding)
 159                 (q-encoding-decode-string str))
 160                (t (message "unknown encoding %s" encoding)
 161                   nil))))
 162     (if dest
 163         (mime/convert-string-to-emacs charset dest)
 164       )))
 165
 166
 167 ;;; @ end
 168 ;;;
 169
 170 (provide 'tm-ew-d)