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