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